webdeck Posted September 26, 2020 Share Posted September 26, 2020 I am wondering how much of original TI source code is available out there. Not decompiled source from ROMs/GROMs, but the original source with comments, which can be a treasure trove of information. What I have found so far: TI-99/4A Console ROM source code (included in The Cyc) RXB purchased the Extended Basic ROM and GROM source code (RXB source code) Is there anything else out there? 1 Quote Link to comment Share on other sites More sharing options...
RXB Posted September 26, 2020 Share Posted September 26, 2020 20 minutes ago, webdeck said: I am wondering how much of original TI source code is available out there. Not decompiled source from ROMs/GROMs, but the original source with comments, which can be a treasure trove of information. What I have found so far: TI-99/4A Console ROM source code (included in The Cyc) RXB purchased the Extended Basic ROM and GROM source code (RXB source code) Is there anything else out there? ET at Sea, but was incomplete. Quote Link to comment Share on other sites More sharing options...
jrhodes Posted September 26, 2020 Share Posted September 26, 2020 The source for Tombstone City is on the E/A disk i think. 2 Quote Link to comment Share on other sites More sharing options...
+retroclouds Posted September 27, 2020 Share Posted September 27, 2020 Check the development resources thread for the source code of: Munchman TI Invaders PARSEC Moon Mine Hopper 2 Quote Link to comment Share on other sites More sharing options...
+Lee Stewart Posted September 27, 2020 Share Posted September 27, 2020 TI Forth source is available as CV182.DSK (“03NOV82”) and CV183.DSK (“08DEC82”) on WHTech. The support code is pretty well documented, but the word definitions in the resident dictionary have little to no documentation. In a way, you could say they are self-documenting because they are mostly DATA statements composed of lists of execution addresses (cfas) that are mnemonic. and follow corresponding high-level Forth code. I have added my own comments to a lot of the code (though not much of the dictionary code) in “Appendix O TMS9900 Assembly Source Code for TI Forth” in my second edition of the TI Forth Manual available in the “Forth – Software” section of the first post of TI-99/4A development resources. ...lee Quote Link to comment Share on other sites More sharing options...
webdeck Posted September 27, 2020 Author Share Posted September 27, 2020 Thanks for the pointer to the development resources thread - great stuff there. I'm surprised that more original source code hasn't surfaced over the years, like the GPL source for GROMs 0-2. Quote Link to comment Share on other sites More sharing options...
+FarmerPotato Posted September 27, 2020 Share Posted September 27, 2020 TI writer and Editor Assembler. There’s a thread somewhere. 1 Quote Link to comment Share on other sites More sharing options...
+FALCOR4 Posted September 27, 2020 Share Posted September 27, 2020 DSR code for the TI sidecar FDC Quote Link to comment Share on other sites More sharing options...
+Ksarul Posted September 28, 2020 Share Posted September 28, 2020 Source code for the BASIC Support Module, the 99/8, and several other utilities are also out there. Source for a few third-party items are also available, like the entire set of source code for the Myarc Geneve and the Personality Card. Quote Link to comment Share on other sites More sharing options...
apersson850 Posted September 29, 2020 Share Posted September 29, 2020 I would have liked the source code for the p-code card as well as at least a kernel unit with interface code (which is delivered with many p-systems, but not the one for the TI 99/4A). Quote Link to comment Share on other sites More sharing options...
+9640News Posted September 29, 2020 Share Posted September 29, 2020 16 minutes ago, apersson850 said: I would have liked the source code for the p-code card as well as at least a kernel unit with interface code (which is delivered with many p-systems, but not the one for the TI 99/4A). There is PSystem source code for the Geneve for MDOS mode that is out there. Beery Quote Link to comment Share on other sites More sharing options...
RXB Posted September 29, 2020 Share Posted September 29, 2020 On 9/27/2020 at 1:34 PM, FarmerPotato said: TI writer and Editor Assembler. There’s a thread somewhere. REA has source code for Editor Assembler but have to go back to RXB Version 1005 to see it. Oh and I released Disk Manager 4 which at time was updated TI version. Disk Manager Cart that you could use 9 Disks, RAMDISK and even demo a GPL fake Disk drive. 1 Quote Link to comment Share on other sites More sharing options...
webdeck Posted September 30, 2020 Author Share Posted September 30, 2020 If you know the links to the items that are "out there" somewhere (or at least the thread if it's on this forum), please add them either here or to the main developer resources thread so they're all in one place. 1 Quote Link to comment Share on other sites More sharing options...
RXB Posted September 30, 2020 Share Posted September 30, 2020 Should I be posting the Source Codes for people? Disk Manager Source Editor Assembler Source XB GPL and ROM source ET AT SEA GPL source 2 1 Quote Link to comment Share on other sites More sharing options...
apersson850 Posted September 30, 2020 Share Posted September 30, 2020 I found some ARK files that look interesting, judging from the file name. Can I view them on something else than a real machine? Simulator? Or is there some program for Windows that opens them directly? Quote Link to comment Share on other sites More sharing options...
+mizapf Posted September 30, 2020 Share Posted September 30, 2020 If you import the ARK files on a DSK image, you can easily view them with TIImageTool. 1 Quote Link to comment Share on other sites More sharing options...
+Ksarul Posted October 1, 2020 Share Posted October 1, 2020 On 9/30/2020 at 1:21 AM, RXB said: Should I be posting the Source Codes for people? Disk Manager Source Editor Assembler Source XB GPL and ROM source ET AT SEA GPL source Please do so, Rich. Source code is always good. . . 4 Quote Link to comment Share on other sites More sharing options...
RXB Posted October 1, 2020 Share Posted October 1, 2020 Spoiler ******************************************************************************** * DISK MANAGER 5 * by RICH GILBERTSON * UPGRADE OF Disk Manger II module by TI * ******************************************************************************** * * FLAGS * N EQU 0 YN EQU 1 NUMBER EQU 2 Y EQU 2 TWO EQU >32 THREE EQU >33 FOUR EQU >34 NINE EQU >39 * * KEYS * CLEAR EQU 2 REDO EQU 6 DOWN EQU 10 PROCD EQU 12 BEGIN EQU 14 BACK EQU 15 SPACE EQU 32 * * GROM * G0000 EQU >0000 * * CPU * MBASE EQU >8300 REDOX EQU >8306 BEGINX EQU >8308 BACKX EQU >830A SCRADD EQU >830C * SCReen ADDress SECNUM EQU >8316 * SECtor NUMber DSKNUM EQU >8318 * DiSK NUMber IOSEC EQU >8319 * Input Output SECtor bit BUFADD EQU >831A * BUFfer ADDress MCFLAG EQU >8329 * Master/Copy FLAG LOGFLG EQU >832A * LOG FLaG ACODE EQU >832D * Access CODE DFLAG EQU >832E * Disk FLAG ONEDSK EQU >8330 * ONE DiSK flag OVROW EQU >8339 * Old Vertical ROW OVCOL EQU >833A * Old Vertical COL CURSOR EQU >833D OUTFLG EQU >833E * OUTput FLAG for catalog device ABORTF EQU >833F * ABORT Flag ADINFO EQU >8340 * ADditional INFO buffer offset MESNUM EQU >8349 * MESsage NUMber FAC EQU >834A 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 ERCODE EQU >8354 FAC11 EQU >8355 FAC12 EQU >8356 FAC13 EQU >8357 FAC17 EQU >835B ARG EQU >835C ARG1 EQU >835D ARG2 EQU >835E MEMSIZ EQU >8370 DATSTK EQU >8372 SUBSTK EQU >8373 KEY EQU >8375 ITIMER EQU >8379 STATUS EQU >837C VCHAR EQU >837D VROW EQU >837E VCOL EQU >837F * * VDP * VBUFF EQU >0B10 * Vdp BUFFer VLEN EQU >0B19 * Length byte NUMAU EQU >0C12 * NUMber of AUs SECTRK EQU >0C14 * SECtors per TRacK SAVCPU EQU >0C28 * SAVe CPU >0C28 - >0C72 (>8300 - >834A) TRACKS EQU >0C1C * Number of TRACKS DMAST EQU >0C72 DCOPY EQU >0C8A SIDES EQU >0E10 * Number of SIDES DENSTY EQU >0E11 * DENSITY ******************************************************************************** GROM >6000 TITL 'DM 2 GROM >6000' DATA >AA02,>0100,>0000,MENU1,>0000,>0000,>0000,>0000 AORG >002A ***************************** COPY FILE **************************************** FCOPY DST FCOPY,@REDOX CALL HEADER * 'COPY FILE' BYTE >24 FCOPY2 CALL GETDRIVEGETINPUT * 'MASTER DISK (1-9)?' BYTE >03,>FF,>FF,>FF,>FF,>FF * >03 = VROW BYTE >4F,>00 * >4F = 'FILENAME?' CALL FILECOPY CALL CMDDONE BR FCOPY2 ***************************** RENAME FILE ************************************** FRENA DST FRENA,@REDOX CALL HEADER * 'RENAME FILE' BYTE >25 CALL GETDRIVEGETINPUT * 'MASTER DISK (1-9)?' BYTE >03,>FF,>FF,>00,>FF,>34 * >03 = VROW BYTE >34,>00 * >34 = 'NEW FILENAME?' DST >0C75,@FAC6 * POINTER TO OLD BUFFER NAME DST >0C8D,@FAC4 * POINTER TO NEW BUFFER NAME ST V@DMAST,@FAC2 * DRIVE NUMBER CALL RENAME CALL CHKERR CALL CMDDONE BR FRENA ***************************** DELETE FILE ************************************** FDEL CALL HEADER * 'DELETE FILE' BYTE >26 DST FDEL,@REDOX CALL DSPLY * 'SELECTIVE (Y/N)?' BYTE >FE,>03,>62,>FF CALL INKEY BYTE YN,>0C,>10,Y CEQ >02,V@>0C10 * Y? BS FDEL3 * Yes FDEL2 CALL GETDRIVEGETINPUT * 'MASTER DISK (1-9)?' BYTE >04,>FF,>FF,>00 * >04 = VROW BYTE >00,>FF ST V@DMAST,@DSKNUM * DRIVE NUMBER CALL DELETE CALL CMDDONE BR FDEL2 FDEL3 CALL GETDRIVEGETINPUT * 'MASTER DISK (1-9)?' BYTE >04,>00,>00,>00 * >04 = VROW BYTE >00,>00 CALL BLINES BYTE >03,>08 DST >0302,@VROW CALL CATALOGER CALL DSPLY * ' FILENAME SIZE TYPE P' * '__________ ____ _______ _' BYTE >FE,>06,>38,>FF FDEL4 DCZ V*>8302 * FILE COUNTER BS FDEL8 DST >0802,@VROW CALL STEPFILE CALL BLINES BYTE >12,>17 CALL DSPLY * 'DELETE (Y/N)?' BYTE >FE,>0B,>45,>FF CALL INKEY BYTE YN,>0C,>1E,N CZ V@>0C1E * N? DELETE BS FDEL7 * No CLOG >08,V@>0E1E * FILE PROTECTED? BS FDEL5 * No CALL OVERIDEPROTECT CZ V@>0C20 * N? OVERRIDE BS FDEL7 * No CALL PROTECTION * UNPROTECT OR PROTECT BYTE >0C,>75,>0C,>72 FDEL5 CALL DELETE CEQ >F8,@DFLAG BR FDEL6 DDECT @>8302 * FILE COUNTER-1 FDEL6 CALL BLINES BYTE >0D,>0D FDEL7 CALL WORKNG * SKIP FILE AND GET NEXT FILE PUSH @>8302 PUSH @>8303 CALL BLINES BYTE >08,>12 DST >0302,@VROW CALL CATALOGER ST *STATUS,@>8303 ST *STATUS,@>8302 B FDEL4 FDEL8 CALL CMDDONE BR FDEL ***************************** MODIFY FILE PROTECTION *************************** FMODP CALL HEADER * 'MODIFY FILE PROTECTION' BYTE >28 DST FMODP,@REDOX FMODP2 CALL GETDRIVEGETINPUT * 'MASTER DISK (1-9)?' BYTE >03,>FF,>FF,>00 * >03 = VROW BYTE >00,>00 DST FMODP2,@REDOX CALL DSPLY * 'PROTECT (Y/N)?' BYTE >FE,>07,>46,>FF CALL INKEY BYTE YN,>0C,>20,N CALL WORKNG DST >0C75,@FAC4 * POINTER TO BUFFER NAME ST V@DMAST,@FAC2 * DRIVE NUMBER CLR @FAC3 * UNPROTECT CZ V@>0C20 * N? PROTECT BS FMODP3 * No INV @FAC3 * PROTECT FMODP3 CALL PROTCT CALL CHKERR CALL CMDDONE BR FMODP ***************************** CATALOG DISK ************************************* DCAT CALL HEADER * 'CATALOG DISK' BYTE >2A DST DCAT,@REDOX CALL GETDRIVEGETINPUT * 'MASTER DISK (1-9)?' BYTE >03,>FF,>00,>00 * >03 = VROW BYTE >00,>00 CALL DSPLY * 'WHERE DO YOU WANT LISTING?' * '1 SCREEN ' * '2 SOLID STATE PRINTER ' * '3 PIO INTERFACE ' * '4 OTHER' * 'YOUR CHOICE?' BYTE >FE,>06,>40,>F5,>41,>F5 BYTE >4E,>FF CALL INKEY BYTE NUMBER,>0C,>25,FOUR ST V@>0C25,@KEY DEC @KEY CASE @KEY BR DCAT4 * Screen BR DCAT1 * Thermal Printer BR DCAT2 * PIO BR DCAT3 * Device input DCAT1 ST >02,V@>0CCF * LENGTH BYTE DST >5450,V@>0CD0 * TP output B DCAT4 DCAT2 MOVE 4,G@G61B1,V@>0CCF * Length byte B DCAT4 G61B1 STRI 'PIO' DCAT3 CALL DSPLY * 'DEVICE NAME?' BYTE >FE,>0C,>50,>F5,>FF CALL GETDEVICENAME * GET DEVICE NAME BYTE >0C,>D0,>38,>0C,>CF DCAT4 CALL WORKNG CALL DSPLY * 'PRESS : ' * ' ' * 'CLEAR TO ABORT COMMAND' BYTE >FE,>16,>5C,>FF ST V@DMAST,@DSKNUM * DRIVE NUMBER CLR @OUTFLG * OUTPUT FLAG OFF CEQ >02,V@>0C21 BR DCAT5 CEQ >01,V@>0C23 BR DCAT5 CEQ >01,V@>0C25 * Screen ouput BS DCAT5 ST >FF,@OUTFLG * OUTPUT FLAG ON CALL EXIO * OPEN,VAR/DIS/OUT/SEQ BYTE >00,>12 DCAT5 CALL BLINES BYTE >03,>12 CALL DSPLY * VROW=>03 VCOL=>02 BYTE >FE,>03,>FF CALL CATALOGER DCZ V*>8302 BS DCAT7 CALL DSPLY * ' FILENAME SIZE TYPE P' * ' ________ ____ _______ _' BYTE >FE,>11,>38,>FF CZ @OUTFLG * OUTPUT FLAG OFF? BS DCAT6 * Yes CALL EXIO * WRITE,ROW,COL BYTE >03,>00,>04 CALL EXIO * WRITE,ROW,COL BYTE >03,>11,>12 DCAT6 BR PAUSE DCAT7 CZ @OUTFLG * OUTPUT FLAG OFF? BS PAUSE * Yes CALL EXIO * WRITE,ROW,COL BYTE >03,>00,>04 PAUSE DCZ V*>8302 * FILE COUNT BS PAUSE4 CALL STEPFILE DCZ @>832B BR PAUSE3 SCAN * SCAN KEYS BR PAUSE3 CEQ CLEAR,@KEY * FCTN 4 BS PAUSE4 CEQ SPACE,@KEY * SPACE? BR PAUSE3 PAUSE2 SCAN * SCAN KEYS BR PAUSE2 CEQ SPACE,@KEY * SPACE? BR PAUSE2 PAUSE3 B PAUSE PAUSE4 CZ @OUTFLG * OUTPUT FLAG OFF? BS PAUSE5 * Yes CALL EXIO * CLOSE CODE BYTE >01 PAUSE5 CALL CMDDONE BR DCAT ****************************** CATALOGER CATALOGER DCLR @SECNUM * SECTOR NUMBER TO READ OR WRITE ST >FF,@IOSEC * SET READ SECTOR BIT DST >0E12,@BUFADD * BUFFER ADDRESS CALL SECTORREADWRITE CALL CHKERR CALL DSPLY * 'DSK - DISKNAME=' BYTE >35,>FF FMT COL 5 SCRO 48 HSTR 1,@DSKNUM * DRIVE NUMBER FEND ST @OVCOL,@VCOL CALL CVRC MOVE 10,V@>0E12,V*SCRADD * COPY BUFFER NAME DST >0640,@FAC ST >C8,@FAC3 DST >0E4A,@FAC4 CATALOGER1 ST V*FAC4,@FAC6 CEQ >FF,@FAC6 BR CATALOGER2 DSUB >0008,@FAC B CATALOGER4 CATALOGER2 CLOG >80,@FAC6 BS CATALOGER3 DDEC @FAC CATALOGER3 SLL >01,@FAC6 CZ @FAC6 BR CATALOGER2 CATALOGER4 DINC @FAC4 DEC @FAC3 BR CATALOGER1 DST @FAC,@>8302 DST V@>0E1C,@>8304 DSUB @>8302,@>8304 CALL ADSPLY * 'AVAILABLE=' BYTE >F5,>36,>FF CALL G70DC * SHOW NUMBER BYTE >02 CALL ADSPLY * 'USED=' BYTE >F0,>01,>37,>FF DDECT @>8304 CALL G70DC * SHOW NUMBER BYTE >04 DST >0001,@SECNUM * SECTOR NUMBER TO READ OR WRITE DST >0D10,@BUFADD * BUFFER ADDRESS CALL SECTORREADWRITE CALL CHKERR DST >0E12,@BUFADD * BUFFER ADDRESS DST >0D10,@>8302 RTN STEPFILE DST >0E12,@BUFADD * BUFFER ADDRESS DST V*>8302,@SECNUM * SECTOR NUMBER TO READ OR WRITE CALL SECTORREADWRITE CALL CHKERR DST V@>0E20,@>8304 DINC @>8304 CALL G6377 CALL CVRC MOVE 10,V@>0E12,V*SCRADD * MOVE BUFFER MOVE 10,V@>0E12,V@>0C75 * COPY BUFFER ADD >0B,@VCOL CALL G70DC * SHOW NUMBER BYTE >04 CLOG >01,V@>0E1E * FILE TYPE BS STEPFILE1 CALL DSPLY * 'PROGRAM' BYTE >E6,>39,>FF BR STEPFILE6 STEPFILE1 CLR @>832F CLOG >02,V@>0E1E * FILE TYPE BS STEPFILE2 CALL DSPLY * 'INT/' BYTE >E6,>3B,>FF BR STEPFILE3 STEPFILE2 CALL DSPLY * 'DIS/' BYTE >E6,>3A,>FF STEPFILE3 CLR @>832F CLOG >80,V@>0E1E * FILE TYPE BS STEPFILE4 CALL DSPLY * 'VAR' BYTE >3C,>FF BR STEPFILE5 STEPFILE4 CALL DSPLY * 'FIX' BYTE >3D,>FF STEPFILE5 CLR @>8304 ST V@>0E23,@>8305 * FILE SIZE CALL G70E2 * SHOW NUMBER BYTE >04 STEPFILE6 CLOG >08,V@>0E1E * FILE TYPE BS STEPFILE7 CALL DSPLY * 'Y' BYTE >FB,>1D,>01,>F5,>FF BR STEPFILE8 STEPFILE7 CALL DSPLY * VROW+1 VCOL=2 BYTE >F5,>FF STEPFILE8 CALL G63A9 DINCT @>8302 RTN G6377 CEQ >02,V@>0C21 BR G63A8 CEQ >01,V@>0C23 BR G63A8 CEQ >2D,V@>00C6 BR G6392 MOVE >0160,V@>0100,V@>00E0 * SCROLL UP 2 LINES BR G6399 G6392 MOVE >01A0,V@>00C0,V@>00A0 * SCROLL UP 2 LINES G6399 ST SPACE,V@>0240 MOVE 31,V@>0240,V@>0241 * BLANK 1 LINE DST >1202,@VROW G63A8 RTN G63A9 CEQ >02,V@>0C21 BR G63BF CEQ >01,V@>0C23 BR G63BF CZ @OUTFLG * OUTPUT FLAG OFF? BS G63BF * Yes CALL EXIO * WRITE,ROW,COL BYTE >03,>12,>12 G63BF RTN ***************************** DISK BACKUP ************************************** DBKUP CALL HEADER * 'BACKUP DISK' BYTE >2B DST DBKUP,@REDOX DBKUP1 ST >F8,V@>0C73 ST >F8,V@>0C8B CALL DSPLY * 'SELECTIVE (Y/N)?' BYTE >FE,>03,>62,>FF CALL INKEY BYTE YN,>0C,>1E,Y DBKUP2 CALL DSPLY * 'MASTER DISK (1-9)?' BYTE >FE,>04,>52,>FF CZ @ONEDSK BS DBKUP3 ST >31,@VCHAR * 1 BR DBKUP4 DBKUP3 CALL INKEY BYTE NUMBER,>0C,>72,NINE DBKUP4 CALL CHECKDISK BYTE >0C,>72,>0E,>12,>0C,>7F CHE >F2,V@>0C73 BS DBKUP5 CZ @ONEDSK BS DBKUP2 CALL BANK5 CALL FCTNBEEP BR DBKUP2 DBKUP5 CALL DSPLY * 'COPY DISK (1-9)?' BYTE >FE,>06,>53,>FF CZ @ONEDSK BS DBKUP6 ST >31,@VCHAR * 1 BR DBKUP7 DBKUP6 CALL INKEY BYTE NUMBER,>0C,>8A,NINE CEQ V@DCOPY,V@DMAST BR DBKUP7 CALL XHONK BR DBKUP5 DBKUP7 CALL CHECKDISK BYTE >0C,>8A,>0E,>12,>0C,>97 CHE >F1,@DFLAG BS DBKUP8 CZ @ONEDSK BS DBKUP5 CALL BANK5 CALL FCTNBEEP BR DBKUP5 DBKUP8 CALL DSPLY * 'INITIALIZE NEW DISK' '(Y/N)?' BYTE >FE,>08,>2F,>61,>FF CEQ >F1,V@>0C8B BS DBKUP9 CEQ >31,V@>0C8B BS DBKUP9 CALL INKEY BYTE YN,>0C,>1F,N BR DBKUPA DBKUP9 ST >59,@VCHAR * Y ST >02,V@>0C1F * Y DBKUPA CEQ >02,V@>0C1F * Y? BR DBKUPE * No CLR V@>0CA1 * START TO INITIALIZE MOVE 10,V@>0C7F,V@>0C97 DST >0C97,@>830E ST >01,@>833C B DBKUPC DBKUPB INC @>833C DBKUPC CGT >0A,@>833C BS DBKUPD CEQ SPACE,V*>830E BS DBKUPD INC V@>0CA1 DINC @>830E B DBKUPB DBKUPD CALL DSPLY * 'NEW DISKNAME?' BYTE >FE,>09,>51,>FF CALL GETINPUT * GET INPUT BYTE >0C,>97,>0A,>0C,>A1 CALL DSPLY BYTE >F5,>FF CALL FORMATINPUT B DBKUPF DBKUPE CEQ >F1,V@>0C8B * INITIALIZED DISK BS DBKUP1 DBKUPF CALL WORKNG CEQ >02,V@>0C1F * Y? INITIALIZE BR DBKUPG * No ST V@DCOPY,@DSKNUM * DRIVE NUMBER CALL DINIT2 DST >0902,@VROW CALL CATALOGER DBKUPG CZ V@>0C1E * N? SELECTIVE BR DBKUPH * Yes CALL DSPLY * 'PRESS ' * ' ' * 'CLEAR TO ABORT COMMAND' BYTE >FE,>16,>5C,>FF DBKUPH CZ V@>0C1E * N? SELECTIVE BR DBKUPI * No ST >02,V@>0C20 * Set YES flag DBKUPI CALL G6B63 DST >0B02,@VROW ST V@DMAST,@DSKNUM * DRIVE NUMBER ST >4D,@MCFLAG * Master CALL CATALOGER CALL DSPLY * ' FILENAME SIZE TYPE P' * ' ________ ____ _______ _' BYTE >FE,>0D,>38,>FF DBKUPJ DCZ V*>8302 BS DBKUPO DCEQ >0001,@SECNUM * SECTOR 1? BS DBKUPK * Yes CEQ >02,V@>0C20 * Y? SELECTIVE BR DBKUPK * No CALL G6B63 DBKUPK DST >0F02,@VROW CALL STEPFILE CZ V@>0C1E * N? SELECTIVE BS DBKUPL * No CALL BLINES BYTE >12,>17 CALL DSPLY * 'COPY FILE' '(Y/N)?' BYTE >FE,>12,>24,>61,>FF CALL INKEY BYTE YN,>0C,>20,N CALL BLINES BYTE >12,>12 CALL WORKNG CZ V@>0C20 * N? COPY FILE BS DBKUPM * No DBKUPL MOVE 10,V@>0C75,V@>0C8D CALL FILECOPY2 DBKUPM CZ V@>0C1E * N? SELECTIVE BR DBKUPN * Yes SCAN * SCAN KEYS BR DBKUPN CEQ CLEAR,@KEY * FCTN4 BS DBKUPO DBKUPN PUSH @>8310 PUSH @>8311 CALL BLINES BYTE >0F,>10 DST >0F02,@VROW ST *STATUS,@>8311 ST *STATUS,@>8310 B DBKUPJ DBKUPO CALL CMDDONE BR DBKUP ***************************** MODIFIY DISK NAME ******************************** DMOD CALL HEADER * 'MODIFY DISK NAME' BYTE >2D DST DMOD,@REDOX CALL GETDRIVEGETINPUT * 'MASTER DISK (1-9)?' BYTE >03,>FF,>00,>00 * >03 = VROW BYTE >00,>00 CALL DSPLY * 'NEW DISKNAME?' BYTE >FE,>06,>51,>FF CALL GETINPUT * GET DISKNAME BYTE >0C,>97,>0A,>0C,>A1 CALL WORKNG CALL SECTORREADWRITE * READ OLD DISKNAME CALL CHKERR MOVE 10,V@>0C97,V@>0E12 * SET UP NEW DISKNAME CLR @IOSEC * SET WRITE SECTOR BIT CALL SECTORREADWRITE * WRITE NEW DISKNAME CALL CHKERR CALL CMDDONE B DMOD ***************************** INITIALIZE DISK ********************************** DINIT CALL HEADER * 'INITIALIZE NEW DISK' BYTE >2F DST DINIT,@REDOX ST >F8,V@>0C73 ST >F8,V@>0C8B CALL DSPLY * 'MASTER DISK (1-9)?' BYTE >FE,>03,>52,>FF ST >31,@VCHAR * 1 CZ @ONEDSK BR DINIT1 CALL INKEY BYTE NUMBER,>0C,>72,NINE DINIT1 CALL CHECKDISK BYTE >0C,>72,>0E,>12,>0C,>7F CALL DSPLY * 'NEW DISKNAME?' BYTE >FE,>06,>51,>FF CALL GETINPUT * GET INPUT BYTE >0C,>97,>0A,>0C,>A1 CALL DSPLY * VROW=>08 BYTE >FC,>08,>FF CALL FORMATINPUT CALL WORKNG ST V@DMAST,@DSKNUM * DRIVE NUMBER CALL DINIT2 CALL DSPLY * VROW=>0C VCOL=>02 BYTE >FE,>0C,>FF CALL CATALOGER CALL CMDDONE BR DINIT DINIT2 CALL INITIALIZEDISK CLR V@>0E12 MOVE >00FF,V@>0E12,V@>0E13 ST >FF,V@>0E4A MOVE >00C7,V@>0E4A,V@>0E4B DST V@NUMAU,@>8312 * Number of AU DCLR @>8310 DDIV >0008,@>8310 DDEC @>8310 CLR V@>0E4A MOVE @>8310,V@>0E4A,V@>0E4B DCZ @>8312 BS FORMATANDMAP2 DADD >0E4B,@>8310 CLR @>8332 * FLAG B FORMATANDMAP1 FORMATANDMAP SLL >01,@>8332 FORMATANDMAP1 INC @>8332 DDEC @>8312 BR FORMATANDMAP INV @>8332 ST @>8332,V*>8310 FORMATANDMAP2 DCLR @SECNUM * SECTOR NUMBER CLR @IOSEC * SET READ SECTOR BIT DST >0E12,@BUFADD * BUFFER ADDRESS ST >03,V@>0E4A MOVE 10,V@>0C97,V@>0E12 * DISK VOLUME NAME DST V@NUMAU,V@>0E1C * NUMBER OF AUs ST V@SECTRK,V@>0E1E * SECTORS PER TRACK DST >4453,V@>0E1F * Store DS CEQ >0A,V@>0C27 * PROPRIETARY? BR FORMATANDMAP3 * No DST >4B50,V@>0E21 * Store KP B FORMATANDMAP4 FORMATANDMAP3 DST >4B20,V@>0E21 * Store K FORMATANDMAP4 ST V@TRACKS,V@>0E23 * TRACKS PER SIDE ST V@SIDES,V@>0E24 * NUMBER OF SIDES ST V@DENSTY,V@>0E25 * DENSITY CALL ABORT * SECTORREADWRITE CALL CHKERR CHE >F8,@DFLAG BR FORMATANDMAP8 DST VBUFF,@BUFADD * BUFFER ADDRESS CLR V@VBUFF * CLEAR THE VDP BUFFER MOVE >00FF,V@VBUFF,V@>0B11 DINC @SECNUM * SECTOR NUMBER+1 CALL ABORT * SECTORREADWRITE CALL CHKERR CHE >F8,@DFLAG BR FORMATANDMAP8 ST >FF,@IOSEC * SET READ SECTOR BIT DST >0002,@>8310 * NEW SECTOR NUMBER 2 FORMATANDMAP5 DST @>8310,@SECNUM * SECTOR NUMBER CALL ABORT * SECTORREADWRITE CHE >F8,@DFLAG BS FORMATANDMAP7 DST @SECNUM,@>8312 * SAVE SECTOR NUMBER DST @SECNUM,@>8314 * SAVE SECTOR NUMBER DSRL >0003,@>8312 DADD >0E4A,@>8312 ST >01,@>8332 DAND >0007,@>8314 DCZ @>8314 BS FORMATANDMAP6 SLL @>8315,@>8332 FORMATANDMAP6 OR @>8332,V*>8312 FORMATANDMAP7 DINC @>8310 DCEQ V@NUMAU,@>8310 * Number of AU BR FORMATANDMAP5 DST >0E12,@BUFADD * BUFFER ADDRESS CLR @IOSEC * SET WRITE SECTOR BIT DCLR @SECNUM * SECTOR NUMBER CALL ABORT * SECTORREADWRITE CALL CHKERR CALL BLINES BYTE >13,>13 FORMATANDMAP8 RTN ***************************** QUICK TEST *************************************** TQICK CLR @ABORTF CALL HEADER * 'QUICK TEST' BYTE >30 DST TQICK,@REDOX TQICK1 ST >F8,V@>0C73 ST >F8,V@>0C8B CALL DSPLY * 'DESTRUCTIVE TEST (Y/N)?' BYTE >FE,>03,>4A,>FF CALL INKEY BYTE YN,>0C,>1E,N CEQ >02,V@>0C1E * Y? DESTRUCTIVE BR TQICK2 * No CALL DSPLY * VROW=>04 BYTE >FC,>04,>FF CALL FORMATINPUT TQICK2 CALL DSPLY * 'MASTER DISK (1-9)?' BYTE >FE,>07,>52,>FF ST >31,@VCHAR * 1 CZ @ONEDSK BR TQICK3 CALL INKEY BYTE NUMBER,>0C,>72,NINE TQICK3 CALL CHECKDISK BYTE >0C,>72,>0E,>12,>0C,>7F CZ V@>0C1E * N? DESTRUCTIVE BR TQICK4 * Yes CHE >F2,V@>0C73 BR TQICK1 TQICK4 CALL DSPLY * 'LOOP (Y/N)?' BYTE >FE,>09,>49,>FF CALL INKEY BYTE YN,>0C,>26,N CALL DSPLY * 'LOG ERRORS (Y/N)?' BYTE >FE,>0A,>5F,>FF CALL INKEY BYTE YN,>0C,>10,N ST V@>0C10,@LOGFLG CEQ >02,@LOGFLG * Y? LOG BR TQICK5 * No CALL DSPLY * 'DEVICE NAME?' BYTE >FE,>0B,>50,>F5,>FF CALL GETDEVICENAME * GET DEVICE NAME BYTE >0C,>D0,>38,>0C,>CF CALL G6AFF TQICK5 CALL WORKNG CEQ >02,@LOGFLG * Y? LOG BR TQICK6 * No CALL EXIO * OPEN,VAR/DIS/OUT/SEQ BYTE >00,>12 CALL EXIO * WRITE,ROW,COL BYTE >03,>00,>03 CALL EXIO * WRITE,ROW,COL BYTE >03,>00,>00 CALL EXIO * CLOSE BYTE >01 TQICK6 DCLR V@>0C16 DCLR V@>0C18 ST >07,@VROW CALL DSPLY * VROW=>08 VCOL=>02 BYTE >FE,>08,>FF ST V@DMAST,@DSKNUM * DRIVE NUMBER CEQ >02,V@>0C1E * Y? DESTRUCTIVE BR TQICK7 * No CALL INITIALIZEDISK TQICK7 CALL DSPLY * 'PRESS ' * ' ' * 'CLEAR TO ABORT COMMAND' BYTE >FE,>16,>5C,>FF TQICK8 CALL ERRORSANDPASS ST V@DMAST,@DSKNUM * DRIVE NUMBER CZ V@>0C1E * N? DESTRUCTIVE BR TQICK9 * Yes CALL READINGSECTORS B TQICKA TQICK9 CALL TCOMPD BYTE >FF BYTE >F7 TQICKA CALL ERRORSANDPASS2 CEQ >02,@ABORTF * ABORT? BS TQICKC * Yes CEQ >02,@LOGFLG * Y? LOG BR TQICKB * No CALL G6AE2 TQICKB CEQ >02,V@>0C26 * Y? LOOP BS TQICK8 * Yes TQICKC CEQ >02,@LOGFLG * Y? LOG BR TQICKD * No CALL G6AEF TQICKD CALL CMDDONE B TQICK ***************************** COMPREHENSIVE TEST ******************************* TCOMP CLR @ABORTF CALL HEADER * 'COMPREHENSIVE TEST' BYTE >31 CALL HEADER2 BYTE >42 ST >F8,V@>0C73 ST >F8,V@>0C8B CALL DSPLY * 'MASTER DISK (1-9)?' BYTE >FE,>04,>52,>FF ST >31,@VCHAR * 1 CZ @ONEDSK BR TCOMP1 CALL INKEY BYTE NUMBER,>0C,>72,NINE TCOMP1 CALL CHECKDISK BYTE >0C,>72,>0E,>12,>0C,>7F CALL DSPLY * VROW=>06 BYTE >FC,>06,>FF CALL FORMATINPUT CALL DSPLY * 'LOOP (Y/N)?' BYTE >FE,>09,>49,>FF CALL INKEY BYTE YN,>0C,>26,N CALL DSPLY * 'LOG ERRORS (Y/N)?' BYTE >FE,>0A,>5F,>FF CALL INKEY BYTE YN,>0C,>10,N ST V@>0C10,@LOGFLG CEQ >02,@LOGFLG * Y? LOG BR TCOMP2 * No CALL DSPLY * 'DEVICE NAME?' BYTE >FE,>0B,>50,>F5,>FF CALL GETDEVICENAME * GET DEVICE NAME BYTE >0C,>D0,>38,>0C,>CF CALL G6AFF TCOMP2 CALL WORKNG CEQ >02,@LOGFLG * Y? LOG BR TCOMP3 * No CALL EXIO * OPEN,VAR/DIS/OUT/SEQ BYTE >00,>12 CALL EXIO * WRITE,ROW,COL BYTE >03,>00,>03 CALL EXIO * CLOSE BYTE >01 TCOMP3 CALL INITIALIZEDISK CALL DSPLY * 'PRESS ' * ' ' * 'CLEAR TO ABORT COMMAND' BYTE >FE,>16,>5C,>FF DCLR V@>0C18 DCLR V@>0C16 CALL ERRORSANDPASS ST V@DMAST,@DSKNUM * DRIVE NUMBER TCOMP4 CALL TESTNUMBER BYTE >01,>6E,>6E CEQ >02,@ABORTF * ABORT? BS TCOMPB * Yes CALL TESTNUMBER BYTE >02,>C5,>C5 CEQ >02,@ABORTF * ABORT? BS TCOMPB * Yes CALL TESTNUMBER BYTE >03,>00,>08 CEQ >02,@ABORTF * ABORT? BS TCOMPB * Yes CALL TESTNUMBER BYTE >04,>FF,>F7 CEQ >02,@ABORTF * ABORT? BS TCOMPB * Yes CALL DSPLY * 'TEST #' BYTE >FE,>14,>63,>19,>FF CEQ >02,@LOGFLG * Y? LOG BR TCOMP5 * No CALL LOGOUTPUT TCOMP5 CEQ >02,@ABORTF * ABORT? BS TCOMPB * Yes DCLR @>8310 * ??????? DST V@NUMAU,@>8312 * Number of AU DDEC @>8312 * AU -1 CLR @IOSEC * SET READ SECTOR BIT TCOMP6 DST @>8310,@SECNUM * SECTOR NUMBER DST @SECNUM,V@>0E12 ST >08,@SCRADD CALL ABORT * SECTORREADWRITE CEQ >02,@ABORTF * ABORT? BS TCOMPB * Yes CALL G6C2C DST @>8312,@SECNUM * SECTOR NUMBER DST @SECNUM,V@>0E12 CALL ABORT * SECTORREADWRITE CEQ >02,@ABORTF * ABORT? BS TCOMPB * Yes CALL G6C2C DINC @>8310 DDEC @>8312 DCGT @>8312,@>8310 BR TCOMP6 ST >FF,@IOSEC * SET WRITE SECTOR BIT DINC @>8310 * ???? DDEC @>8312 * ????? CALL DSPLY * 'TEST #' BYTE >FE,>14,>63,>1A,>FF CEQ >02,@LOGFLG * Y? LOG BR TCOMP7 * No CALL LOGOUTPUT TCOMP7 DDEC @>8310 DINC @>8312 * ??????? DCEQ @>8312,@>8310 * ???????? BS TCOMP8 DST @>8310,@SECNUM * SECTOR NUMBER CALL ABORT * SECTORREADWRITE CEQ >02,@ABORTF * ABORT? BS TCOMPB * Yes CALL G6C2C DCEQ @SECNUM,V@>0E12 BS TCOMP8 ST >08,@SCRADD ST >99,@DFLAG CALL G6C31 TCOMP8 DST @>8312,@SECNUM * SECTOR NUMBER CALL ABORT * SECTORREADWRITE CEQ >02,@ABORTF * ABORT? BS TCOMPB * Yes CALL G6C2C CEQ >F8,@DFLAG BR TCOMP9 DCEQ @SECNUM,V@>0E12 BS TCOMP9 ST >99,@DFLAG CALL G6C31 TCOMP9 DCZ @>8310 BR TCOMP7 CALL BLINES BYTE >14,>14 CALL ERRORSANDPASS2 CEQ >02,@LOGFLG * Y? LOG BR TCOMPA * No CALL G6AE2 TCOMPA CEQ >02,V@>0C26 * Y? LOOP BS TCOMP4 * Yes TCOMPB CEQ >02,@LOGFLG * Y? LOG BR TCOMPC * No CALL G6AEF TCOMPC CALL CMDDONE BR TCOMP TCOMPD PUSH @>8310 PUSH @>8311 B TESTNUMBER2 TESTNUMBER PUSH @>8310 PUSH @>8311 DCLR @>8310 FETCH @>8311 CALL DSPLY * 'TEST #' BYTE >FE,>14,>63,>FF CALL G70F2 BYTE >10 CEQ >02,@LOGFLG * Y? LOG BR TESTNUMBER2 * No CALL LOGOUTPUT TESTNUMBER2 FETCH @>8311 ST @>8311,V@>0E12 MOVE >00FF,V@>0E12,V@>0E13 FETCH @>8310 ST @>8310,V@>0E92 ST *STATUS,@>8311 ST *STATUS,@>8310 DCLR @SECNUM * SECTOR NUMBER CLR @IOSEC * SET WRITE SECTOR BIT DST >0E12,@BUFADD * BUFFER ADDRESS B READINGSECTORS1 READINGSECTORS DCLR @SECNUM * SECTOR NUMBER ST >FF,@IOSEC * SET READ SECTOR BIT DST >0E12,@BUFADD * BUFFER ADDRESS READINGSECTORS1 CALL ABORT * SECTORREADWRITE CEQ >02,@ABORTF * ABORT? BS READINGSECTORS2 * Yes CALL G6C2C DINC @SECNUM * SECTOR NUMBER+1 DST V@NUMAU,@FAC12 * Number of AU DCEQ @FAC12,@SECNUM BR READINGSECTORS1 CALL BLINES BYTE >14,>14 READINGSECTORS2 RTN ERRORSANDPASS PUSH @>8314 PUSH @>8315 PUSH @VCOL PUSH @VROW DST V@>0C18,@>8314 CALL DSPLY * ' TOTAL ERRORS:' BYTE >FE,>11,>5E,>FF BR ERRORSANDPASS3 ERRORSANDPASS2 PUSH @>8314 PUSH @>8315 PUSH @VCOL PUSH @VROW DINC V@>0C16 DST V@>0C16,@>8314 CALL DSPLY * 'COMPLETED PASS:' BYTE >FE,>12,>5D,>FF ERRORSANDPASS3 CALL G70CC * SHOW NUMBER BYTE >14 ST *STATUS,@VROW ST *STATUS,@VCOL ST *STATUS,@>8315 ST *STATUS,@>8314 RTN INITIALIZEDISK CALL BLINES BYTE >13,>13 CALL DSPLY * 'INITIALIZE NEW DISK' BYTE >FE,>14,>2F,>FF ST @DSKNUM,@FAC2 * DRIVE NUMBER ST V@TRACKS,@FAC3 * NUMBER OF TRACKS DST >0E12,@FAC4 * BUFFER ADDRESS ST V@SIDES,@FAC7 * NUMBER OF SIDES CEQ >01,@FAC7 * 1 SIDE? BS INITIALIZEDISK1 * Yes OR >10,@FAC2 INITIALIZEDISK1 ST V@DENSTY,@FAC6 * DENSITY CEQ >01,@FAC6 BS INITIALIZEDISK2 OR >20,@FAC2 INITIALIZEDISK2 CEQ >28,@FAC3 * 40 TRACK? BS INITIALIZEDISK3 * Yes CEQ >23,@FAC3 * 35 TRACK? BS INITIALIZEDISK3 * Yes OR >10,@FAC2 INITIALIZEDISK3 CALL FORMAT DST @FAC,V@NUMAU * Get Number of AU DST @FAC3,V@SECTRK * Sectors per Track CEQ >02,V@SIDES * 2 SIDES? BR INITIALIZEDISK4 * No CEQ >02,@FAC7 * 2 SIDES? BS INITIALIZEDISK4 * Yes ST >01,V@SIDES * 1 SIDE INITIALIZEDISK4 CALL CHKERR CALL BLINES BYTE >14,>14 RTN LOGOUTPUT CALL EXIO * OPEN,VAR/DIS/APE/SEQ BYTE >00,>16 CALL EXIO * WRITE,ROW,COL BYTE >03,>14,>14 BR G6AFA G6AE2 CALL EXIO * OPEN,VAR/DIS/APE/SEQ BYTE >00,>16 CALL EXIO * WRITE,ROW,COL BYTE >03,>12,>12 BR G6AFA G6AEF CALL EXIO * OPEN,VAR/DIS/APE/SEQ BYTE >00,>16 CALL EXIO * WRITE,ROW,COL BYTE >03,>11,>11 G6AFA CALL EXIO * CLOSE BYTE >01 RTN G6AFF DCEQ >4453,V@>0CD0 * DS? BR G6B25 CEQ >4B,V@>0CD2 * K? BR G6B25 ST V@DMAST,@>830E ADD >30,@>830E * ADD ASCII 0 CEQ V@>0CD3,@>830E BR G6B25 CALL DSPLY * 'LISTING DEVICE ERROR' BYTE >FE,>14,>43,>FF CALL HONKFCTN BR FCTN8 G6B25 RTN ***************************** HONK ********************************************* XHONK CALL BADTON BR G6B2E ***************************** BEEP ********************************************* XBEEP CALL ACCTON G6B2E CLR @ITIMER G6B30 CZ @>83CE BR G6B30 RTN PUSH @VCOL PUSH @VROW ST SPACE,V@>0C7F MOVE 9,V@>0C7F,V@>0C80 CALL BANK5 CALL DSPLY * 'LOAD MASTER DISK' BYTE >FE,>14,>0E,>FF CALL FCTNBEEP CALL BLINES BYTE >15,>15 ST >4D,@MCFLAG * Master ******************************* Restore VROW VCOL RESTOREVROWVCOL ST *STATUS,@VROW ST *STATUS,@VCOL RTN G6B63 PUSH @VCOL PUSH @VROW ST >4D,@MCFLAG * Master CZ @ONEDSK BS RESTOREVROWVCOL CALL READSECTOR BR RESTOREVROWVCOL G6B73 PUSH @VCOL PUSH @VROW ST SPACE,V@>0C97 MOVE 9,V@>0C97,V@>0C98 CALL BANK5 CALL DSPLY * 'LOAD COPY DISK' BYTE >FE,>14,>0F,>FF CALL FCTNBEEP CALL BLINES BYTE >15,>15 ST >43,@MCFLAG * Copy B RESTOREVROWVCOL G6B9A PUSH @VCOL PUSH @VROW ST >43,@MCFLAG * Copy CZ @ONEDSK BS RESTOREVROWVCOL CALL READSECTOR BR RESTOREVROWVCOL READSECTOR CALL G6BF8 DST VBUFF,@BUFADD * BUFFER ADDRESS ST >FF,@IOSEC * SET READ SECTOR BIT ST V@DMAST,@DSKNUM * DRIVE NUMBER CEQ >4D,@MCFLAG * Master? BS G6BC1 * Yes ST V@DCOPY,@DSKNUM * DRIVE NUMBER G6BC1 DCLR @SECNUM * SECTOR NUMBER G6BC3 CALL SECTORREADWRITE DST >0C7F,@FAC CEQ >4D,@MCFLAG * Master? BS G6BD3 * Yes DST >0C97,@FAC G6BD3 DST VBUFF,@FAC2 ST >01,@>833C B G6BDF G6BDD INC @>833C G6BDF CGT >05,@>833C BS G6BF2 DCEQ V*FAC2,V*FAC BR G6BF3 DINCT @FAC DINCT @FAC2 B G6BDD G6BF2 RTN G6BF3 CALL G6BF8 BR G6BC3 G6BF8 CALL BANK5 DST >1502,@VROW CALL DSPLY * 'DISKNAME=' BYTE >33,>FF CALL CVRC CEQ >4D,@MCFLAG * Master? BR G6C1C * No MOVE 10,V@>0C7F,V*SCRADD CALL DSPLY * 'LOAD MASTER DISK' BYTE >FE,>14,>0E,>FF BR FCTNBEEP G6C1C MOVE 10,V@>0C97,V*SCRADD CALL DSPLY * 'LOAD COPY DISK' BYTE >FE,>14,>0F,>FF BR FCTNBEEP G6C2C CEQ >F8,@DFLAG BS G6C97 G6C31 MOVE >00E0,V@>0140,V@>0120 * SCROLL 7 LINES ST SPACE,V@>0220 MOVE 31,V@>0220,V@>0221 * BLANK 1 LINE DINC V@>0C18 PUSH @>8310 PUSH @>8311 PUSH @VCOL PUSH @VROW DST V@>0C18,@>8310 CALL XHONK CALL DSPLY * ' TOTAL ERRORS:' BYTE >FE,>11,>5E,>FF CALL G70DC * SHOW NUMBER BYTE >10 CALL DSPLY * 'BAD ADDRESS/CODE' BYTE >FE,>10,>56,>FF CALL G70DC * SHOW NUMBER BYTE >16 CALL DSPLY * VCOL+1 BYTE >E0,>FF CALL G6CB4 CEQ >02,@LOGFLG * Y? LOG BR G6C87 * No CALL EXIO * OPEN,VAR/DIS/APE/SEQ BYTE >00,>16 CALL EXIO * WRITE,ROW,COL BYTE >03,>10,>10 CALL EXIO * CLOSE BYTE >01 G6C87 ST *STATUS,@VROW ST *STATUS,@VCOL ST *STATUS,@>8311 ST *STATUS,@>8310 G6C97 RTN **************************** Check for error CHKERR CEQ >F8,@DFLAG BS G6CB3 CALL BLINES BYTE >14,>14 CALL DSPLY * VROW=>14 VCOL=>02 'DISK ERROR' BYTE >FE,>14,>05,>FF CALL BLINES BYTE >15,>15 CALL G6CB4 BR HONKFCTN G6CB3 RTN G6CB4 PUSH @>8310 PUSH @>8311 CLR @>8310 ST @DFLAG,@>8311 AND >F0,@>8311 SRL >04,@>8311 CALL G70F2 BYTE >10 CLR @>8310 ST @DFLAG,@>8311 AND >0F,@>8311 CALL G70F2 BYTE >10 ST *STATUS,@>8311 ST *STATUS,@>8310 RTN ***************************** Calculate Vaddr from ROW and COL CVRC CLR @SCRADD ST @VROW,@>830D DSLL >0005,@SCRADD ADD @VCOL,@>830D RTN DELETE CALL DELETE1 * LENGTH,BUFFER ADDRESS BYTE >07,>0C,>72 RTN DELETE1 CLR V@VBUFF MOVE 10,V@VBUFF,V@>0B11 FETCH @>830E * Max device name length ST @>830E,V@VBUFF FETCH @>830E * Buffer address FETCH @>830F * Buffer address MOVE 6,G@G6D5F,V@VLEN * Get DSK0. into PAB ADD @DSKNUM,V@>0B1D * DRIVE NUMBER MOVE 10,V@>0C75,V@>0B1F * Get filename CLR V@>0B11 DST @>830E,@FAC * Get buffer address DADD >0003,@FAC ST >01,@FAC3 * COUNTER=1 B DELETE3 DELETE2 INC @FAC3 * COUNTER +1 DELETE3 CGT >0A,@FAC3 * Filename length > 10 ? BS DELETE4 * Yes CEQ SPACE,V*FAC * End filename? BS DELETE4 * Yes INC V@VLEN * Length +1 DINC @FAC * Address of name +1 B DELETE2 DELETE4 DST VLEN,@FAC12 * Length byte CALL LINK BYTE >08 BS DELETE5 ST V@>0B11,@DFLAG SRL >05,@DFLAG CZ @DFLAG BR DELETE6 ST >F8,@DFLAG BR DELETE6 DELETE5 ST >F0,@DFLAG DELETE6 ST @DFLAG,V@>0001(@>830E) BR CHKERR G6D5F STRI 'DSK0.' ***************************** DSRLNK routine * Parm 1 I/O op * 0, flags * 3, row, col * Other EXIO MOVE >004A,@MBASE,V@SAVCPU FETCH @>8332 * Get flag ST @>8332,V@>0CC6 * I/O CODE CZ @>8332 * FLAG<>0 BR EXIO1 * Yes FETCH @>8332 * Get byte ST @>8332,V@>0CC7 * FILE TYPE * >0CC8 = BUFFER ADDDRESS ST >20,V@>0CCA * LOGICAL RECORD LENGTH ST >20,V@>0CCB * CHARACTER COUNT DCLR V@>0CCC * RECORD NUMBER CLR V@>0CCE * SCREEN OFFSET DST >0CCF,@FAC12 * LENGTH BYTE CALL LINK BYTE >08 BS G6DE1 * ERROR CALL CHECKOPCODE BR EXIO4 * No error EXIO1 CEQ >03,V@>0CC6 * CLOSE? BR EXIO3 * No DCLR @>8310 DCLR @>8312 FETCH @>8311 DSLL >0005,@>8310 FETCH @>8313 DINC @>8312 DSLL >0005,@>8312 EXIO2 DST >0CCF,@FAC12 * Length byte DST @>8310,V@>0CC8 CALL LINK BYTE >08 BS G6DE1 * ERROR CALL CHECKOPCODE DADD >0020,@>8310 * SCREEN ADDRESS +32 DCEQ @>8312,@>8310 * SCREEN ADDRESS = LAST LINE BR EXIO2 B EXIO4 EXIO3 DST >0CCF,@FAC12 * Length byte CALL LINK BYTE >08 BS G6DE1 * ERROR CALL CHECKOPCODE EXIO4 MOVE >004A,V@SAVCPU,@MBASE RTN G6DE1 CLR @DFLAG B LISTINGDEVICEERROR CHECKOPCODE ST V@>0CC7,@DFLAG * I/O CODE SRL >05,@DFLAG CZ @DFLAG BR LISTINGDEVICEERROR ST >F8,@DFLAG RTN LISTINGDEVICEERROR CALL DSPLY * 'LISTING DEVICE ERROR' BYTE >F3,>FE,>14,>43,>FF DCLR @>830E ST @DFLAG,@>830F CALL G70F2 BYTE >0E CALL HONKFCTN B FCTN8 ***************************** BLANK LINES (VROW,COUNT) BLINES PUSH @VCOL PUSH @VROW FETCH @VROW FETCH @SCRADD CLR @VCOL G6E16 FMT HCHA 32,' ' FEND CZ @VROW BS RESTOREVROWVCOL CH @SCRADD,@VROW BR G6E16 B RESTOREVROWVCOL BANK5 ST SPACE,V@>027F * BLANK 5 LINES MOVE >00A0,V@>027F,V@>0280 RTN ****************************** INITILIAZE DISK INPUT FORMATINPUT CALL DSPLY * 'TRACKS PER SIDE?' BYTE >FB,>02,>4D,>FF MOVE 4,G@G6EAD,V@VBUFF CALL GETINPUT * GET INPUT BYTE >0B,>11,>02,>0B,>10 CEQ >01,V@VBUFF BR FORMATINPUT1 ST >20,V@>0B12 FORMATINPUT1 DST >0B11,@FAC12 * TRACKS PER SIDE CLR @ERCODE XML >10 * CSN CZ @ERCODE BS FORMATINPUT2 CALL XHONK BR FORMATINPUT FORMATINPUT2 XML >12 * CFI CZ @ERCODE BS FORMATINPUT3 CALL XHONK BR FORMATINPUT FORMATINPUT3 ST @FAC1,V@TRACKS CALL DSPLY * 'SINGLE SIDED (Y/N)?' BYTE >F5,>4C,>FF CALL INKEY BYTE YN,>0E,>10,N CEQ >02,V@SIDES * Y? SINGLE SIDED BR FORMATINPUT4 * No ST >01,V@SIDES * SINGLE SIDED BR FORMATINPUT5 FORMATINPUT4 ST >02,V@SIDES * DOUBLE SIDED FORMATINPUT5 CALL DSPLY * 'SINGLE DENSITY (Y/N)?' BYTE >F5,>4B,>FF CALL INKEY BYTE YN,>0E,>11,N CEQ >02,V@DENSTY * Y? SINGLE DENSITY BR FORMATINPUT6 * No ST >01,V@DENSTY * SINGLE DENSITY BR FORMATINPUT7 FORMATINPUT6 ST >02,V@DENSTY * DOUBLE DENSITY FORMATINPUT7 RTN G6EAD BYTE >02,>34,>30,>20 SECTOR DST >0110,V@>0C1A * W/R SECTOR B LEVEL1 FORMAT DST >0111,V@>0C1A * FORMAT DISK LEVEL1 DST >0C1A,@FAC12 CALL LINK BYTE >0A BS G6F0D ST @FAC6,@DFLAG * ERROR CODE CZ @FAC6 BR G6ED4 ST >F8,@DFLAG * NO ERROR BR G6ED7 G6ED4 ADD >10,@DFLAG * ? G6ED7 RTN PROTCT DST >0112,V@>0C1A * PROTECT/UNPROTECT B LEVEL2 RENAME DST >0113,V@>0C1A * RENAME B LEVEL2 FILEIN DST >0114,V@>0C1A * FILE INPUT B LEVEL2 FILEOU DST >0115,V@>0C1A * FILE OUTPUT LEVEL2 DST >0C1A,@FAC12 CALL LINK BYTE >0A BS G6F0D SRL >05,@FAC6 ST @FAC6,@DFLAG CZ @DFLAG BR G6F0C ST >F8,@DFLAG G6F0C RTN G6F0D ST >F0,@DFLAG RTN ABORT PUSH @VCOL PUSH @VROW DCZ @>832B BR ABORT1 SCAN * SCAN KEYS BR ABORT1 CEQ CLEAR,@KEY * FCTN4 BR ABORT1 ST >02,@ABORTF ABORT1 DST >130D,@VROW CALL G70DC * SHOW NUMBER BYTE >16 CEQ >FF,@IOSEC * WRITE SECTOR BIT SET? BR ABORT2 * No ST >3E,@VCHAR * > BR ABORT3 ABORT2 ST >3C,@VCHAR * < ABORT3 ST *STATUS,@VROW ST *STATUS,@VCOL SECTORREADWRITE DST @SECNUM,@FAC6 * SECTOR NUMBER TO READ OR WRITE DST @DSKNUM,@FAC2 * DRIVE NUMBER/READ OR WRITE BIT DST @BUFADD,@FAC4 * BUFFER ADDRESS B SECTOR ***************************** Key Scan KSCAN CLR @ITIMER KSCAN1 SCAN * SCAN KEYS BS KSCAN2 CHE >14,@ITIMER BR KSCAN1 EX @CURSOR,@VCHAR B KSCAN KSCAN2 CEQ >60,@VCHAR BR KSCAN3 EX @CURSOR,@VCHAR KSCAN3 CEQ DOWN,@KEY * FCTN X BR KSCAN6 INC V@>0C27 CEQ >0A,V@>0C27 BS KSCAN4 CALL XHONK BR KSCAN5 KSCAN4 CALL XBEEP KSCAN5 CALL G740E BR KSCAN KSCAN6 RTN G6F81 INC @VCOL * VCOL+1 CH >1D,@VCOL BR G6F8D G6F88 INC @VROW * VROW+1 ST >02,@VCOL * VCOL=2 G6F8D RTN G6F8E DEC @VCOL CGE >02,@VCOL BS G6F9A ST >1D,@VCOL DEC @VROW G6F9A RTN CHECKDISK PUSH @>8310 PUSH @>8311 FETCH @>8302 * DRIVE NUMBER ADDRESS FETCH @>8303 * DRIVE NUMBER ADDRESS ST V*>8302,@DSKNUM * DRIVE NUMBER FETCH @BUFADD * BUFFER ADDRESS FETCH @BUFADD+1 * BUFFER ADDRESS CHECKDISK1 CZ @ONEDSK BS CHECKDISK3 PUSH @VROW PUSH @VCOL DCEQ >0C8A,@>8302 BR CHECKDISK2 CALL G6B73 CHECKDISK2 ST *STATUS,@VCOL ST *STATUS,@VROW CHECKDISK3 DCLR @SECNUM * SECTOR NUMBER ST >FF,@IOSEC * SET READ SECTOR BIT CALL SECTORREADWRITE CEQ >F8,@DFLAG BR CHECKDISK4 ST >F1,@DFLAG DCEQ >4453,V@>000D(@BUFADD) * DS? BR CHECKDISK4 CEQ >4B,V@>000F(@BUFADD) * K? BR CHECKDISK4 INC @VROW ST >02,@VCOL CALL DSPLY * BLANK >1C BYTES BYTE >F0,>1C,>FF ST >02,@VCOL CALL DSPLY * 'DISKNAME=' BYTE >33,>FF CALL CVRC MOVE 10,V*BUFADD,V*SCRADD ADD >0A,@VCOL DST V@>000A(@BUFADD),V@NUMAU * Number of AU DST V@>000C(@BUFADD),V@SECTRK * Sectors per Track ST >F8,@DFLAG CEQ >50,V@>0010(@BUFADD) * P? BR CHECKDISK4 ST >F2,@DFLAG * PROPRITARY DISK ERROR CHECKDISK4 CEQ >16,@DFLAG BR CHECKDISK5 CALL DSPLY * VROW+2 VCOL=>02 'DISK ERROR' BYTE >F5,>05,>FF CALL G6CB4 CALL DSPLY * BLANK >0A BYTES BYTE >F0,>0A,>FF BR G70B8 CHECKDISK5 CEQ >F0,@DFLAG BR CHECKDISK6 CALL DSPLY * 'DISK ERROR' BYTE >F5,>05,>E6,>E9,>F0,>0D BYTE >FF BR G70B8 CHECKDISK6 CEQ >31,@DFLAG * ERROR? BS CHECKDISK7 * Yes CEQ >32,@DFLAG * ERROR? BS CHECKDISK7 * Yes CEQ >F1,@DFLAG BR CHECKDISK8 CHECKDISK7 CALL DSPLY * 'DISK NOT INITIALIZED' BYTE >F5,>57,>F0,>05,>FF ST >F1,@DFLAG CHECKDISK8 CHE >F0,@DFLAG BS CHECKDISK9 CEQ >31,@DFLAG BS CHECKDISK9 CEQ >16,@DFLAG BS CHECKDISK9 CALL DSPLY * VROW+2 VCOL=>02 'DISK ERROR' BYTE >F5,>05,>FF CALL G6CB4 CALL DSPLY * BLANK >0A BYTES BYTE >F0,>0A,>FF CHECKDISK9 FETCH @>8310 FETCH @>8311 CHE >F8,@DFLAG BS CHECKDISKA CALL XHONK CHECKDISKA CHE >F2,@DFLAG BS CHECKDISKB ST SPACE,V*BUFADD * CLEAR NAME BUFFER MOVE 9,V*BUFADD,V@>0001(@BUFADD) CHECKDISKB MOVE 10,V*BUFADD,V*>8310 DCEQ >0C7F,@>8310 BR CHECKDISKC ST @DFLAG,V@>0C73 * WHY ????????? BR CHECKDISKD CHECKDISKC ST @DFLAG,V@>0C8B CHECKDISKD ST *STATUS,@>8311 ST *STATUS,@>8310 RTN G70B8 CALL XHONK PUSH @VROW CALL BANK5 CALL FCTNBEEP ST *STATUS,@VROW DEC @VROW B CHECKDISK1 G70CC ST >FF,@ERCODE * SHOW NUMBER FETCH @FAC DST *FAC,@FAC DST >2710,@FAC4 B G7105 G70DC ST >FF,@ERCODE * SHOW NUMBER B G70F5 G70E2 ST >FF,@ERCODE * SHOW NUMBER FETCH @FAC DST *FAC,@FAC DST >0064,@FAC4 B G7105 G70F2 CLR @ERCODE G70F5 FETCH @FAC DST *FAC,@FAC B G7101 CLR @ERCODE G7101 DST >03E8,@FAC4 G7105 DST @FAC,@FAC2 CLR @FAC11 G710B DCLR @FAC DDIV @FAC4,@FAC CEQ >FF,@FAC11 BR G711E FMT SCRO 48 HSTR 1,@FAC1 FEND B G7137 G711E DCZ @FAC BS G712E FMT SCRO 48 HSTR 1,@FAC1 FEND ST >FF,@FAC11 B G7137 G712E CEQ >FF,@ERCODE BR G7137 FMT HTEX ' ' FEND G7137 DST @FAC4,@FAC6 DCLR @FAC4 DDIV >000A,@FAC4 DCEQ >0001,@FAC4 BR G710B FMT SCRO 48 HSTR 1,@FAC3 FEND RTN HONKFCTN CALL XHONK CALL DSPLY * 'PRESS: PROC'D, REDO,' * ' BEGIN OR BACK' BYTE >FE,>16,>12,>FF BR G7171 FCTNBEEP CALL DSPLY * 'PRESS: PROC'D, REDO,' * ' BEGIN OR BACK' BYTE >FE,>16,>12,>FF BR BEEPFCTN BLANK5FCTNBEEP CALL BANK5 CALL DSPLY * 'SCREEN IS COMPLETE' * 'PRESS: PROC'D, REDO,' * ' BEGIN OR BACK' BYTE >FE,>15,>11,>F5,>12,>FF BEEPFCTN CALL XBEEP G7171 ST SPACE,@VCHAR CALL KSCAN CEQ REDO,@KEY * FCTN 8 BR G7181 G717C CALL BANK5 BR FCTN8 G7181 CEQ BEGIN,@KEY * FCTN 5 BR G718B CALL BANK5 BR FCTN5 G718B CEQ BACK,@KEY * FCTN 9 BR G7195 CALL BANK5 BR FCTN9 G7195 CEQ PROCD,@KEY * FCTN 6 BR G71A3 CEQ >F8,@DFLAG BR G717C CALL WORKNG RTN G71A3 CALL XHONK BR G7171 ***************************** Subroutine CMDDONE CALL BANK5 CALL DSPLY * 'COMMAND COMPLETED' * 'PRESS: PROC'D, REDO,' * ' BEGIN OR BACK' BYTE >FE,>15,>0D,>F5,>12,>FF CALL XBEEP G71B7 ST SPACE,@VCHAR CALL KSCAN CALL FCTN CEQ PROCD,@KEY * FCTN 6 BR G71C6 RTN G71C6 CALL XHONK BR G71B7 WORKNG CALL BANK5 CALL DSPLY * 'WORKING..... PLEASE WAIT.' BYTE >FE,>15,>10,>FF RTN OVERIDEPROTECT CALL DSPLY * 'OVERRIDE PROTECTION (Y/N)?' BYTE >F4,>47,>FF CALL INKEY BYTE YN,>0C,>20,N RTN ***************************** Subroutine, 4 bytes fetched PROTECTION FETCH @FAC4 * UNPROTECT OR PROTECT FETCH @FAC5 FETCH @FAC2 FETCH @FAC3 ST V*FAC2,@FAC2 CLR @FAC3 CEQ >02,V@>0C20 * >02=YES BR G71FD CALL PROTCT BR CHKERR G71FD RTN GETDRIVEGETINPUT CALL BLINES BYTE >04,>17 ST >F8,V@>0C73 ST >F8,V@>0C8B FETCH @>831C * ROW value CEQ >FF,@ONEDSK BR G7217 ST V@DMAST,V@DCOPY G7217 FETCH @>831E * ROW+1 FLAG FETCH @>831F * FILENAME FLAG FETCH @>8320 * COPY DISK FLAG CEQ >FF,@>8320 * COPY DISK FLAG? BR G7224 * No FETCH @>8321 * ROW+1 FLAG G7224 FETCH @>8322 * 'N' FLAG CEQ >FF,@>8322 * 'N' FLAG? BR G722D * No FETCH @>8324 * MESSAGE NUMBER G722D FETCH @>8326 * RETURN FLAG ST @>831C,@VROW * GET ROW ST >02,@VCOL DST @VROW,@>8327 * SAVE VROW G7238 DST @>8327,@VROW * RESTORE VROW CALL DSPLY * 'MASTER DISK (1-9)?' BYTE >52,>FF ST >31,@VCHAR * 1 CZ @ONEDSK BR G724E CALL INKEY BYTE NUMBER,>0C,>72,NINE G724E CALL CHECKDISK BYTE >0C,>72,>0E,>12,>0C,>7F CALL G6F88 * VROW+1 VCOL=2 CHE >F8,@DFLAG BS G7270 CEQ >F2,@DFLAG BS G7270 CZ @ONEDSK BS G726E CALL BANK5 CALL FCTNBEEP G726E BR G7238 G7270 DST @>8327,@VROW INC @VROW CEQ >FF,@>831E * ROW+1 FLAG BR G727C * No INC @VROW G727C CEQ >FF,@>831F * FILENAME FLAG BR G728E * No CALL DSPLY * 'FILENAME?' BYTE >4F,>FF CALL GETINPUT * GET INPUT BYTE >0C,>75,>0A,>0C,>74 G728E INCT @VROW ST >02,@VCOL G7293 DST @>8327,@VROW * RESTORE VROW ADD >03,@VROW * VROW+3 CEQ >FF,@>831E * ROW+1 FLAG BR G72A0 * No INC @VROW G72A0 CZ @>8320 * COPY DISK FLAG BR G72A9 * Yes ST V@DMAST,V@DCOPY G72A9 CEQ >FF,@>8320 * COPY DISK FLAG BR G72DC * No CALL DSPLY * 'COPY DISK (1-9)?' BYTE >53,>FF ST >31,@VCHAR * 1 CZ @ONEDSK BR G72D3 CALL INKEY BYTE NUMBER,>0C,>8A,NINE CEQ >02,V@>0C21 BR G72D3 CEQ V@DCOPY,V@DMAST BR G72D3 CALL XHONK BR G7293 G72D3 CALL CHECKDISK BYTE >0C,>8A,>0E,>12,>0C,>97 G72DC CALL G6F88 * VROW+1 VCOL=2 CHE >F8,@DFLAG BS G72F5 CEQ >F2,@DFLAG BS G72F5 CZ @ONEDSK BS G72F3 CALL BANK5 CALL FCTNBEEP G72F3 BR G7293 G72F5 DST @>8327,@VROW * RESTORE VROW ADD >04,@VROW * VROW+4 CEQ >FF,@>831E * ROW+1 FLAG BR G7302 * No INC @VROW G7302 CEQ >FF,@>8320 * COPY DISK FLAG BR G730E * No CEQ >FF,@>8321 * ROW+1 FLAG BR G730E * No INC @VROW G730E CEQ >FF,@>8322 * 'N' FLAG BR G7323 * No CLR @FAC6 * CLEAR MESSAGE NUMBER ST @>8324,@FAC7 * GET MESSAGE NUMBER CALL DMSG CALL GETINPUT * GET INPUT BYTE >0C,>8D,>0A,>0C,>8C G7323 CZ @>8326 * RETURN FLAG BR BLANK5FCTNBEEP RTN FILECOPY CALL G6B63 FILECOPY2 ST V@DMAST,@FAC2 * DRIVE NUMBER CLR @FAC3 * ACCESS CODE DST >0C75,@FAC4 * POINTER TO BUFFER NAME ST >40,@FAC6 * OFFSET POINTER TO ADDITIONAL INFO DST >0E12,@ADINFO * BUFFER START ADDRESS CALL FILEIN ST @>8331,@ACODE * ACCESS CODE CALL CHKERR CHE >F8,@DFLAG BR G73E4 PUSH @>8342 PUSH @>8343 DCLR @>8342 B G7356 G7353 CALL G6B63 G7356 ST V@DMAST,@DSKNUM * DRIVE NUMBER DST VBUFF,@BUFADD * BUFFER ADDRESS DCLR @SECNUM * SECTOR NUMBER ST >FF,@IOSEC * SET READ SECTOR BIT CALL SECTORREADWRITE CEQ >50,V@>0B20 * P? BR G7379 * No CALL DSPLY * 'PROPRIETARY DISK ERROR' BYTE >F3,>FE,>14,>60,>FF CALL HONKFCTN BR FCTN8 G7379 ST V@DMAST,@FAC2 * DRIVE NUMBER ST @ACODE,@FAC3 * ACCESS CODE DST >0C75,@FAC4 * POINTER TO BUFFER NAME ST >40,@FAC6 * OFFSET POINTER TO ADDITIONAL INFO CALL FILEIN ST @FAC3,@ACODE * ACCESS CODE CALL CHKERR CHE >F8,@DFLAG BR G73E4 CALL G6B9A DCZ @>8342 BR G73BE ST *STATUS,@>8343 * STATUS FLAG ST *STATUS,@>8342 * NUMBER OF FIRST RECORD ST V@DCOPY,@FAC2 * DRIVE NUMBER CLR @FAC3 * ACCESS CODE DST >0C8D,@FAC4 * POINTER TO BUFFER NAME ST >40,@FAC6 * OFFSET POINTER TO ADDITIONAL INFO CALL FILEOU CALL CHKERR CHE >F8,@DFLAG BR G73E4 DCLR @>8342 G73BE ST V@DCOPY,@FAC2 * DRIVE NUMBER ST @ACODE,@FAC3 * ACCESS CODE DST >0C8D,@FAC4 * POINTER TO BUFFER NAME ST >40,@FAC6 * OFFSET POINTER TO ADDITIONAL INFO CALL FILEOU CALL CHKERR CHE >F8,@DFLAG BR G73E4 CLR @>830E ST @ACODE,@>830F * ACCESS CODE DADD @>830E,@>8342 * NUMBER OF FIRST SECTOR CHE @>8331,@ACODE * ACCESS CODE BS G7353 G73E4 RTN ***************************** DISPLAY HEADING (parm=message #) HEADER ALL SPACE CLR @VROW HEADER2 INC @VROW CLR @>8310 FETCH @>8311 * MESSAGE # DST @>8310,@FAC6 * Save it DADD @>8310,@>8310 * Double it DADD @MBASE,@>8310 * Add in >8300+Message# MOVE 4,G@G0000(@>8310),@>8312 * Get index address DSUB @>8312,@>8314 SRL >01,@>8315 ST >10,@VCOL SUB @>8315,@VCOL CALL DMSG * Put message on screen G740E CEQ >0A,V@>0C27 BS G741A DST >2020,V@>000F * SPACE SPACE RTN G741A DST >3E3C,V@>000F * <> RTN ***************************** Subroutine, 4 bytes fetched INKEY FETCH @FAC * FLAG byte FETCH @FAC1 * Flag address FETCH @FAC2 * Flag address CEQ >02,@FAC * Message? BR INKEY1 * No. FETCH @FAC5 * Highest key BR INKEY3 INKEY1 FETCH @MESNUM * Message # DST @MBASE,@FAC7 * >8300 DADD >0002,@FAC7 * >8300+2 MOVE 2,G@G0000(@FAC7),@FAC9 * Get index address MOVE 1,G@G0000(@FAC9),@FAC11 * Single byte DST @MBASE,@FAC7 * >8300 DADD >0000,@FAC7 * What the heck is this? MOVE 2,G@G0000(@FAC7),@FAC9 * Get index address MOVE 1,G@G0000(@FAC9),@FAC12 * Single byte CEQ >02,@MESNUM * Single letter? BR INKEY2 * No ST @FAC11,V*FAC1 * Save single character 123456789 BR INKEY3 INKEY2 ST @FAC12,V*FAC1 * Save single character YN INKEY3 CALL XBEEP DST @OVROW,@VROW ST V*FAC1,@VCHAR * Show character CEQ >02,@FAC BR INKEY4 ADD >30,@VCHAR * Add >30 to NUMBER INKEY4 CALL KSCAN CGT >0F,@KEY BS INKEY5 DEC @KEY CASE @KEY BR INKEY8 * FCTN 7 BR INKEY3 * FCTN 4 BR INKEY8 * FCTN 1 BR INKEY8 * FCTN 2 BR INKEY8 * FCTN = BR INKEY9 * FCTN 8 BR INKEY8 * FCTN 3 BR INKEY8 * FCTN S BR INKEY8 * FCTN D BR INKEYA * FCTN X BR INKEY8 * FCTN E BR INKEY8 * FCTN 6 BR INKEYA * ENTER BR FCTN5 * FCTN 5 BR FCTN9 * FCTN 9 INKEY5 CEQ >01,@FAC BR INKEY6 CEQ @FAC11,@KEY BS INKEY6 CEQ @FAC12,@KEY BR INKEY8 INKEY6 CEQ >02,@FAC BR INKEY7 CH @FAC5,@KEY BS INKEY8 CHE >31,@KEY * 1? BR INKEY8 INKEY7 ST @KEY,@VCHAR BR INKEY4 INKEY8 CALL XHONK BR INKEY4 INKEY9 B FCTN8 INKEYA CEQ >01,@FAC BR INKEYC ST @VCHAR,@KEY CEQ @FAC11,@VCHAR BR INKEYB ST >02,V*FAC1 BR INKEYC INKEYB CLR V*FAC1 INKEYC CEQ >02,@FAC BR INKEYD ST @VCHAR,V*FAC1 SUB >30,V*FAC1 ST V*FAC1,@KEY INKEYD RTN GETDEVICENAME ST >02,@FAC17 * GET DEVICE NAME B GETINPUT1 GETINPUT CLR @FAC17 * GET INPUT GETINPUT1 FETCH @FAC12 FETCH @FAC13 FETCH @FAC ST >01,@FAC1 GETINPUT2 CALL G6F81 INC @FAC1 CEQ @FAC,@FAC1 BR GETINPUT2 CALL CVRC DST @SCRADD,@FAC5 DST @VROW,@FAC3 CALL XBEEP FETCH @ARG FETCH @ARG1 ST V*ARG,@FAC2 GETINPUT3 DST @OVROW,@VROW DST @FAC12,@ARG2 ST >01,@FAC1 CZ @FAC2 BS GETINPUT5 GETINPUT4 ST V*ARG2,@VCHAR DINC @ARG2 CALL G6F81 INC @FAC1 CH @FAC2,@FAC1 BR GETINPUT4 GETINPUT5 CGT @FAC,@FAC1 BS GETINPUT7 CALL CVRC GETINPUT6 ST >61,@VCHAR CALL G6F81 CALL CVRC DCGT @FAC5,@SCRADD BR GETINPUT6 GETINPUT7 DST @OVROW,@VROW GETINPUT8 CLR @FAC7 MOVE 8,G@G8010,V@>0B00 GETINPUT9 EX @CURSOR,@VCHAR CALL KSCAN CGT >0F,@KEY BS GETINPUTA DEC @KEY CASE @KEY BR GETINPUTH * FCTN 7 BR GETINPUTI * FCTN 4 BR GETINPUTJ * FCTN 1 BR GETINPUTM * FCTN 2 BR GETINPUTH * FCTN = BR FCTN8 * FCTN 8 BR GETINPUTH * FCTN 3 BR GETINPUTO * FCTN S BR GETINPUTP * FCTN D BR GETINPUTH * FCTN X BR GETINPUTH * FCTN E BR GETINPUTH * FCTN 6 BR GETINPUTQ * ENTER BR FCTN5 * FCTN 5 BR FCTN9 * FCTN 9 GETINPUTA CZ @FAC17 BR GETINPUTB CEQ SPACE,@KEY * SPACE? BS GETINPUTH CEQ >2E,@KEY * PERIOD? BS GETINPUTH GETINPUTB CEQ >FF,@FAC7 BR GETINPUTE CEQ @FAC,@FAC2 BS GETINPUTH DST @VROW,@FAC8 CALL CVRC DCEQ @FAC5,@SCRADD BS GETINPUTH ST @VCHAR,@ERCODE CALL G6F81 GETINPUTC ST @VCHAR,@FAC11 ST @ERCODE,@VCHAR ST @FAC11,@ERCODE CALL G6F81 CALL CVRC DCGT @FAC5,@SCRADD BS GETINPUTD CEQ >61,@ERCODE BR GETINPUTC GETINPUTD DST @FAC8,@VROW ST >61,@VCHAR GETINPUTE CEQ >61,@VCHAR BR GETINPUTF INC @FAC2 GETINPUTF ST @KEY,@VCHAR CALL CVRC DCEQ @FAC5,@SCRADD BS GETINPUTG CALL G6F81 GETINPUTG B GETINPUT9 GETINPUTH CALL XHONK BR GETINPUT9 GETINPUTI CLR @FAC2 B GETINPUT3 GETINPUTJ CEQ >61,@VCHAR BS GETINPUTH CZ @FAC2 BS GETINPUTH DEC @FAC2 DST @VROW,@FAC8 CALL CVRC DCEQ @FAC5,@SCRADD BS GETINPUTL DST @FAC5,@>8310 DSUB @SCRADD,@>8310 GETINPUTK CALL G6F81 ST @VCHAR,V*SCRADD CEQ >61,@VCHAR BS GETINPUTL CALL CVRC DCEQ @FAC5,@SCRADD BR GETINPUTK GETINPUTL ST >61,@VCHAR DST @FAC8,@VROW B GETINPUT8 GETINPUTM CZ @FAC2 BS GETINPUTH CEQ @FAC,@FAC2 BS GETINPUTH DCEQ >004D,@VROW GETINPUTN BS GETINPUTH ST >FF,@FAC7 MOVE 8,G@G8018,V@>0B00 B GETINPUT9 GETINPUTO DCEQ @OVROW,@VROW BS GETINPUTH CALL G6F8E BR GETINPUT8 GETINPUTP CALL CVRC DCEQ @FAC5,@SCRADD BS GETINPUTH CEQ >61,@VCHAR BS GETINPUTH CALL G6F81 BR GETINPUT8 GETINPUTQ CZ @FAC2 BS GETINPUTH DST @OVROW,@VROW CLR @FAC1 GETINPUTR CEQ >61,@VCHAR BR GETINPUTS ST SPACE,@VCHAR GETINPUTS ST @VCHAR,V*FAC12 DINC @FAC12 CALL G6F81 INC @FAC1 CEQ @FAC,@FAC1 BR GETINPUTR ST @FAC2,V*ARG MOVE 8,G@G8010,V@>0B00 RTN FCTN CEQ REDO,@KEY * FCTN 8 BS FCTN8 CEQ BEGIN,@KEY * FCTN 5 BS FCTN5 CEQ BACK,@KEY * FCTN 9 BS FCTN9 RTN FCTN8 DST @REDOX,V@>0C1A B G76C2 FCTN5 DST @BEGINX,V@>0C1A B G76C2 FCTN9 DST @BACKX,V@>0C1A G76C2 CALL BANK5 ST >7E,@SUBSTK ST >9E,@DATSTK CALL G76CE G76CE DST V@>0C1A,*SUBSTK MOVE 8,G@G8010,V@>0B00 RTN ***************************** Display Message. 8350=msg # DMSG DCHE >0064,@FAC6 * Highest number of messeges BS DMSG1 DST @MBASE,@FAC4 BR DMSG2 DMSG1 DST @>8337,@FAC4 DSUB >0064,@FAC6 DMSG2 DADD @FAC6,@FAC4 DADD @FAC6,@FAC4 MOVE 4,G@G0000(@FAC4),@FAC6 DSUB @FAC6,@FAC8 CALL CVRC MOVE @FAC8,G@G0000(@FAC6),V*SCRADD DST @FAC8,@>830E DSRL >0005,@FAC8 ADD @FAC9,@VROW AND >1F,@>830F ADD @>830F,@VCOL DMSG3 CZ @>832F BS DMSG4 ST SPACE,@VCHAR INC @VCOL DMSG4 ST >FF,@>832F DST @VROW,@OVROW RTN BYTE >2F,>2C,>2A,>3D,>23,>3F BYTE >20,>3E,>3C,>30 ADSPLY ST >00,@>832F ***************************** Multi-lingual display * >F0nn nn blanks to current posn * >F1 blank lines 1-18 * >F2 blank line 18 * >F3 blank lines 20-23 * >F4 VROW+2, VCOL=2 * >F5 VROW+1, VCOL=2 * >FF end of parms * >FB fetch VCOL * >FC fetch VROW * >FE fetch VROW, VCOL=2 DSPLY CLR @FAC6 DSPLY1 FETCH @FAC7 CALL CVRC CHE >E0,@FAC7 BS DSPLY2 CALL DMSG BR DSPLY DSPLY2 CHE >F0,@FAC7 BS DSPLY3 MOVE 1,G@GETINPUTN(@FAC6),V*SCRADD INC @VCOL B DSPLY DSPLY3 CEQ >FF,@FAC7 BS DMSG4 CH >FA,@FAC7 BS DSPLYC SUB >F0,@FAC7 CASE @FAC7 BR DSPLY4 BR DSPLY6 BR DSPLY7 BR DSPLY8 BR DSPLYA BR DSPLYB CALL DMSG3 BR DSPLY DSPLY4 FETCH @FAC2 DSPLY5 ST SPACE,@VCHAR INC @VCOL DEC @FAC2 BR DSPLY5 BR DSPLY1 DSPLY6 DST @VROW,@FAC11 FMT COL 0 ROW 0 FOR 19 HCHA 32,' ' ROW+ 1 FEND FEND B DSPLY9 DSPLY7 DST @VROW,@FAC11 CALL BLINES BYTE >12,>12 BR DSPLY9 DSPLY8 DST @VROW,@FAC11 CALL BLINES BYTE >14,>17 DSPLY9 DST @FAC11,@VROW B DSPLY1 DSPLYA INC @VROW DSPLYB INC @VROW ST >02,@VCOL B DSPLY1 DSPLYC CEQ >FC,@FAC7 BR DSPLYD FETCH @VROW DSPLYD CEQ >FB,@FAC7 BR DSPLYE FETCH @VCOL DSPLYE CEQ >FD,@FAC7 BR DSPLYF FETCH @VCOL CLR @VROW DSRC >0004,@VROW SRL >04,@VROW DSPLYF CEQ >FE,@FAC7 BR DSPLYG FETCH @VROW ST >02,@VCOL DSPLYG B DSPLY1 ******************************************************************************** MENU1 DATA >0000 DATA ENGLSH STRI 'DISK MANAGER 5' ******************************************************************************** ENGLSH DST ENGMSG,@MBASE ALL SPACE G81F2 DST DMANGR,@BEGINX ST >01,@FAC2 * CALL FILES 1 DST >0116,V@>0C1A * DST >0C1A,@FAC12 * CALL LINK * BYTE >0A * ALL SPACE DST >0900,@FAC CALL LOCASE * Load lower case ST >01,V@DMAST ST >02,V@DCOPY DCLR @>832B DST @MEMSIZ,@>830E DINC @>830E DSUB >0E12,@>830E ST @>830E,@>8331 ST >FF,@>832F ST >60,@CURSOR MOVE 8,G@G8010,V@>0B00 * CURSOR MOVE 8,G@G8020,V@>0B08 * EDGE CHARACTER CLR @ONEDSK ST >01,V@>0C21 MOVE 5,V@>0C21,V@>0C22 CLR V@>0C74 CLR V@>0C8C CLR V@>0CCF * Length byte CLR V@>0C27 ***************************** Disk Manager ************************************* DMANGR DST DMANGR,@REDOX DST QUIT,@BACKX CALL HEADER * 'DISK MANAGER' BYTE >1E CALL DSPLY * '1' 'FILE COMMANDS' * '2' 'DISK COMMANDS' * '3' 'DISK TESTS' * BYTE >F4,>15,>1F,>F4,>16,>20 BYTE >F4,>17,>21,>FF CZ @ONEDSK BR SINGLE CALL DSPLY * '4''SET ALL COMMANDS FOR SINGLE DISK PROCESSING' * 'YOUR CHOICE?' BYTE >F4,>18,>22,>FE,>16,>4E BYTE >FF CALL INKEY BYTE NUMBER,>0C,>21,FOUR BR NORMAL SINGLE CALL DSPLY * 'SINGLE DISK PROCESSING HAS BEEN INITIALIZED' * 'YOUR CHOICE?' BYTE >F4,>23,>FE,>16,>4E,>FF CALL INKEY BYTE NUMBER,>0C,>21,THREE NORMAL DEC @KEY CASE @KEY BR FMANGR BR DCMDS BR DTEST ST >FF,@ONEDSK ST >01,V@DMAST ST >01,V@DCOPY ST >01,V@>0C21 B DMANGR QUIT EXIT ***************************** File Manger ************************************** FMANGR DST FMANGR,@REDOX DST DMANGR,@BACKX CALL HEADER * 'FILE COMMANDS' BYTE >1F CALL DSPLY * '1' 'COPY FILE' * '2' 'RENAME FILE' * '3' 'DELETE FILE' * '4' 'MODIFIY FILE PROTECTION' * 'YOUR CHOICE?' BYTE >F4,>15,>24,>F4,>16,>25 BYTE >F4,>17,>26,>F4,>18,>28 BYTE >FE,>16,>4E,>FF CALL INKEY BYTE NUMBER,>0C,>22,FOUR DEC @KEY DST FMANGR,@BACKX CLR V@>0C74 CLR V@>0C8C CASE @KEY BR FCOPY BR FRENA BR FDEL BR FMODP ***************************** Disk Commands ************************************ DCMDS DST DCMDS,@REDOX DST DMANGR,@BACKX CALL HEADER * 'DISK COMMANDS' BYTE >20 CALL DSPLY * '1' 'CATALOG DISK' * '2' 'BACKUP DISK' * '3' 'MODIFY DISK NAME' * '4' 'INITIALIZE NEW DISK' * 'YOUR CHOICE?' BYTE >F4,>15,>2A,>F4,>16,>2B BYTE >F4,>17,>2D,>F4,>18,>2F BYTE >FE,>16,>4E,>FF CALL INKEY BYTE NUMBER,>0C,>23,FOUR DEC @KEY DST DCMDS,@BACKX CLR V@>0C89 CLR V@>0CA1 CASE @KEY BR DCAT BR DBKUP BR DMOD BR DINIT ***************************** Disk Tests *************************************** DTEST DST DTEST,@REDOX DST DMANGR,@BACKX CALL HEADER * 'DISK TESTS' BYTE >21 CALL DSPLY * '1' 'QUICK TEST' * '2' 'COMPREHENSIVE TEST' * 'YOUR CHOICE?' BYTE >F4,>15,>30,>F4,>16,>31 BYTE >FE,>16,>4E,>FF CALL INKEY BYTE NUMBER,>0C,>24,TWO DEC @KEY DST DTEST,@BACKX CLR V@>0C89 CLR V@>0CA1 CASE @KEY BR TQICK BR TCOMP ****************************** GROM 8000 *************************************** GROM >8000 AORG >0010 G8010 TEXT '<<$$$$<<' * CURSOR CHARACTER G8018 TEXT 'xx````xx' * EDGE CHARACTER G8020 BYTE >00,>00,>00,>00,>24,>24,>3C,>3C,>42,>59 ***************************** Message Table ************************************ * ADDRESS OF MESSAGES IN GROM ENGMSG DATA G8448,G8449,G844A DATA G844A,G844A,G844A DATA G8454,G8454,G8454 DATA G8454,G8454,G8454 DATA G8454,G8454,G8465 DATA G8475,G8483,G849D DATA G84AF,G84E4,G84E4 DATA G84E4,G84E5,G84E6 DATA G84E7,G84E8,G84E9 DATA G84EA,G84EB,G84EC DATA G84ED,G84F9,G8506 DATA G8513,G851D,G8553 DATA G8583,G858C,G8597 DATA G85A2,G85A2,G85B8 DATA G85B8,G85C4,G85CF DATA G85CF,G85DF,G85DF DATA G85F2,G85FC,G860E DATA G860E,G8617,G8624 DATA G8635,G863F,G8645 DATA G8681,G8688,G868C DATA G8690,G8693,G8696 DATA G8696,G8696,G86B0 DATA G8717,G8722,G8736 DATA G8736,G8743,G8751 DATA G876B,G876B,G8776 DATA G878D,G87A2,G87B5 DATA G87C5,G87D1,G87DA DATA G87E6,G87F3,G8805 DATA G8815,G8815,G8815 DATA G8825,G8839,G8839 DATA G8839,G8839,G8839 DATA G886F,G887E,G888D DATA G889E,G88B4,G88BA DATA G88CA,G88D0 ***************************** TEXT MESSAGES ************************************ G8448 TEXT 'N' * >00 G8449 TEXT 'Y' * >01 G844A TEXT 'DISK ERROR' * >05 G8454 TEXT 'COMMAND COMPLETED' * >0D G8465 TEXT 'LOAD MASTER DISK' * >0E G8475 TEXT 'LOAD COPY DISK' * >0F G8483 TEXT 'WORKING..... PLEASE WAIT.' * >10 G849D TEXT 'SCREEN IS COMPLETE' * >11 G84AF TEXT 'PRESS: PROC''D, REDO, BEGIN, OR BACK' * >12 G84E4 TEXT '1' * >15 G84E5 TEXT '2' * >16 G84E6 TEXT '3' * >17 G84E7 TEXT '4' * >18 G84E8 TEXT '5' * >19 G84E9 TEXT '6' * >1A G84EA TEXT '7' * >1B G84EB TEXT '8' * >1C G84EC TEXT '9' * >1D G84ED TEXT 'DISK MANAGER' * >1E G84F9 TEXT 'FILE COMMANDS' * >1F G8506 TEXT 'DISK COMMANDS' * >20 G8513 TEXT 'DISK TESTS' * >21 G851D TEXT 'SET ALL COMMANDS FOR SINGLE DISK PROCESSING' * >22 G8553 TEXT 'SINGLE DISK PROCESSING HAS BEEN INITIALIZED' * >23 G8583 TEXT 'COPY FILE' * >24 G858C TEXT 'RENAME FILE' * >25 G8597 TEXT 'DELETE FILE' * >26 G85A2 TEXT 'MODIFY FILE PROTECTION' * >28 G85B8 TEXT 'CATALOG DISK' * >2A G85C4 TEXT 'BACKUP DISK' * >2B G85CF TEXT 'MODIFY DISK NAME' * >2D G85DF TEXT 'INITIALIZE NEW DISK' * >2F G85F2 TEXT 'QUICK TEST' * >30 G85FC TEXT 'COMPREHENSIVE TEST' * >31 G860E TEXT 'DISKNAME=' * >33 G8617 TEXT 'NEW FILENAME?' * >34 G8624 TEXT 'DSK - DISKNAME=' * >35 G8635 TEXT 'AVAILABLE=' * >36 G863F TEXT ' USED=' * >37 G8645 TEXT ' FILENAME SIZE ' * >38 TEXT ' TYPE P ' TEXT '---------- ---- ' TEXT '---------- -' G8681 TEXT 'PROGRAM' * >39 G8688 TEXT 'DIS/' * >3A G868C TEXT 'INT/' * >3B G8690 TEXT 'VAR' * >3C G8693 TEXT 'FIX' * >3D G8696 TEXT 'WHERE DO YOU WANT LISTING?' * >40 G86B0 TEXT '1 SCREEN ' * >41 TEXT ' ' TEXT '2 SOLID STATE PRINTER ' TEXT '3 PIO INTERFACE ' TEXT '4 OTHER' G8717 TEXT 'DESTRUCTIVE' * >42 G8722 TEXT 'LISTING DEVICE ERROR' * >43 G8736 TEXT 'DELETE (Y/N)?' * >45 G8743 TEXT 'PROTECT (Y/N)?' * >46 G8751 TEXT 'OVERRIDE PROTECTION (Y/N)?' * >47 G876B TEXT 'LOOP (Y/N)?' * >49 G8776 TEXT 'DESTRUCTIVE TEST (Y/N)?' * >4A G878D TEXT 'SINGLE DENSITY (Y/N)?' * >4B G87A2 TEXT 'SINGLE SIDED (Y/N)?' * >4C G87B5 TEXT 'TRACKS PER SIDE?' * >4D G87C5 TEXT 'YOUR CHOICE?' * >4E G87D1 TEXT 'FILENAME?' * >4F G87DA TEXT 'DEVICE NAME?' * >50 G87E6 TEXT 'NEW DISKNAME?' * >51 G87F3 TEXT 'MASTER DISK (1-9)?' * >52 G8805 TEXT 'COPY DISK (1-9)?' * >53 G8815 TEXT 'BAD ADDRESS/CODE' * >56 G8825 TEXT 'DISK NOT INITIALIZED' * >57 G8839 TEXT 'PRESS: ' * >5C TEXT ' ' TEXT 'CLEAR TO ABORT COMMAND' G886F TEXT 'COMPLETED PASS:' * >5D G887E TEXT ' TOTAL ERRORS:' * >5E G888D TEXT 'LOG ERRORS (Y/N)?' * >5F G889E TEXT 'PROPRIETARY DISK ERROR' * >60 G88B4 TEXT '(Y/N)?' * >61 G88BA TEXT 'SELECTIVE (Y/N)?' * >62 G88CA TEXT 'TEST #' * >63 G88D0 BYTE >00 ******************************************************************************** END 1 Quote Link to comment Share on other sites More sharing options...
RXB Posted October 1, 2020 Share Posted October 1, 2020 Above was Rich Disk Manager 5 This below is RXB2001 but the XB source is there, lost the original in a Hard Drive failure. Spoiler *********************************************************** TITL 'MYXB3' *********************************************************** GROM >6000 *********************************************************** TITL 'EQUATES EDIT-359' *********************************************************** CPUBAS EQU >A040 CRU base *********************************************************** * GROM ADDRESSES MZMSG EQU >6038 Start of message area MZPSCN EQU >6A70 Module PSCAN branch table add *********************************************************** OUTREC EQU >801A G8024 EQU >8024 CHKEND in upper GROM is diffe KEYTAB EQU >CB00 ERRTAB EQU >CD77 TRACBK EQU >CE1F RETNOS EQU >CF68 EDTZZ0 EQU >D000 Edit a line or display it tab EDTZ00 EQU >D00D Edit a line or display it SAVLIN EQU >D0AF Save input line address GE025 EQU >E025 RXB PATCH CODE FOR EA CART *********************************************************** * EQUATES FOR ROUTINES FROM OTHER SECTIONS CLSALL EQU >8012 CLose ALL open files SAVE EQU >8014 SAVE a program OLD EQU >8016 OLD (load a program) LIST EQU >8018 LIST a program OLD1 EQU >8026 A subprogram for LOAD MERGE EQU >8028 MERGE a program GRMLST EQU >802A List program line from ERAM GRSUB2 EQU >802C Read from ERAM(GREAD1) or VDP GRSUB3 EQU >802E Read from ERAM(use GREAD1) or * VDP, reset prossible bkpt to ATNZZ EQU >0032 Arctangent routine ERRZ EQU >6A84 ERRor routine EXEC EQU >A004 ASC EQU >A00A EXEC1 EQU >A00C EXECute a program statememt EXEC6D EQU >A00E DELINK EQU >A010 SQUISH EQU >A014 INTRND EQU >A018 Initilize random number LINK1 EQU >A026 LINK to subprogram *********************************************************** * Equates for routine in MONITOR CALDSR EQU >10 CALL DEVICE SERVICE ROUTINE TONE1 EQU >34 ACCEPT TONE TONE2 EQU >36 BAD TONE *********************************************************** * Equates for XMLs SYNCHK EQU >00 SYNCHK XML selector SEETWO EQU >03 SEETWO XML selector COMPCT EQU >70 PREFORM A GARBAGE COLLECTION MEMCHK EQU >72 MEMORY check routine: VDP VPUSH EQU >77 Push on value stack VPOP EQU >78 Pop off value stack PGMCHR EQU >79 GET PROGRAM CHARACTER SCHSYM EQU >7D Search symbol table SPEED EQU >7E SPEED UP XML CRUNCH EQU >7F Crunch an input line CONTIN EQU >81 Continue after a break SCROLL EQU >83 SCROLL THE SCREEN IO EQU >84 IO utility (KW table search) GREAD EQU >85 READ DATA FROM ERAM GWRITE EQU >86 WRITE DATA TO ERAM DELREP EQU >87 REMOVE CONTENT FROM VDP/ERAM MVDN EQU >88 MOVE DATA IN VDP/ERAM MVUP EQU >89 MOVE DATA IN VDP/ERAM VGWITE EQU >8A MOVE DATA FROM VDP TO ERAM GVWITE EQU >8B WRITE DATA FROM GRAM TO VRAM GDTECT EQU >8E ERAM DETECT&ROM PAGE 1 ENABLE SCNSMT EQU >8F SCAN STATEMENT FOR PRESCAN *********************************************************** * GPL Status Block STACK EQU >8372 STACK FOR DATA KEYBD EQU >8374 KEYBOARD SELCTION RKEY EQU >8375 KEY CODE RANDOM EQU >8378 RANDOM NUMBER GENERATOR TIMER EQU >8379 TIMING REGISTER MOTION EQU >837A NUMBER OF MOVING SPRITES VDPSTS EQU >837B VDP STATUS REGISTER ERCODE EQU >837C STATUS REGISTER *********************************************************** * Temporary workspaces in EDIT VAR0 EQU >8300 TEMPORARY VARV EQU >8301 TEMPORARY ACCUM EQU >8302 # OF BYTES ACCUMULATOR (4 BYTE STPT EQU >8302 TWO BYTES VARY EQU >8304 VARY2 EQU >8306 PABPTR EQU >8304 DFLTLM EQU >8306 Default array limit (10) CCPPTR EQU >8306 OFFSET WITHIN RECORED (1) RECLEN EQU >8307 LENGTH OF CURRENT RECORD (1) CCPADR EQU >8308 RAM address of current refs VARC EQU >8308 CCPADD EQU >8308 RAM address of current color CALIST EQU >830A Call list for resolving refs RAMPTR EQU >830A Pointer for crunching BYTES EQU >830C BYTE COUNTER NMPTR EQU >830C Pointer save for pscan CHSAV EQU >830E CURINC EQU >830E Increment for auto-num mode TOPSTK EQU >8310 Top of data stack pointer LINUM EQU >8312 Used to determine end of scan NMLEN EQU >8314 Current line for auto-num CURLIN EQU >8314 Current line for auto-num VAR9 EQU >8316 XFLAG EQU >8316 SCAN FLAG-BITS USED AS BELOW DSRFLG EQU >8317 INTERNAL =60, EXTERNAL =0 (1) FORNET EQU >8317 Nesting level of for/next AAA1 EQU >8302 BBB1 EQU >830C CCC1 EQU >8308 *********************************************************** * Permanent workspace variables STRSP EQU >8318 String space begining STREND EQU >831A String space ending SREF EQU >831C Temporary string pointer SMTSRT EQU >831E Start of current statement VARW EQU >8320 Screen address 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 EXTRAM EQU >832E Line number table pointer STLN EQU >8330 Start of line number table ENLN EQU >8332 End of line number table DATA EQU >8334 Data pointer for READ LNBUF EQU >8336 Line table pointer for READ INTRIN EQU >8338 Add of intrinsic poly constant SUBTAB EQU >833A Subprogram symbol table IOSTRT EQU >833C PAB list/Start of I/O chain SYMTAB EQU >833E Symbol table pointer FREPTR EQU >8340 Free space pointer CHAT EQU >8342 Current charater/token BASE EQU >8343 OPTION BASE value PRGFLG EQU >8344 Program/imperative flag FLAG EQU >8345 General 8-bit flag BUFLEV EQU >8346 Crunch-buffer destruction leve LSUBP EQU >8348 Last subprogram block on stack * FAC EQU >834A Floating-point ACcurmulator FAC1 EQU FAC+1 FAC2 EQU FAC+2 FAC3 EQU FAC+3 FAC4 EQU FAC+4 FAC5 EQU FAC+5 FAC6 EQU FAC+6 FAC7 EQU FAC+7 FAC8 EQU FAC+8 FAC9 EQU FAC+9 FAC10 EQU FAC+10 FAC12 EQU FAC+12 FAC13 EQU FAC+13 FAC14 EQU FAC+14 FAC15 EQU FAC+15 FAC16 EQU FAC+16 FAC17 EQU FAC+17 AAA EQU FAC+2 CCC EQU FAC+4 BBB EQU FAC+6 DDD EQU FAC+2 FFF EQU FAC+4 EEE EQU FAC+6 DDD1 EQU FAC+10 FFF1 EQU FAC+12 EEE1 EQU FAC+14 * ARG EQU >835C Floating-point ARGument ARG1 EQU ARG+1 ARG2 EQU ARG+2 ARG3 EQU ARG+3 ARG4 EQU ARG+4 ARG5 EQU ARG+5 ARG6 EQU ARG+6 ARG7 EQU ARG+7 ARG8 EQU ARG+8 XSTLN EQU >8364 GKXB variable XENLN EQU >8366 GKXB variable ARG11 EQU ARG+11 XCURLI EQU >8368 GKXB variable XCURIN EQU >836A GKXB variable ARG15 EQU ARG+15 ARG16 EQU ARG+16 * VSPTR EQU >836E Value stack pointer EXPZ EQU >8376 Exponent in floating-point RAMTOP EQU >8384 Highest address in ERAM RAMFRE EQU >8386 Free pointer in the ERAM RSTK EQU >8388 Subroutine stack base RAMFLG EQU >8389 ERAM flag STKMIN EQU >83AF Base of data stack STKMAX EQU >83BD Top of data stack PRTNFN EQU >83CE *********************************************************** * VDP addresses NLNADD EQU >02E2 New LiNe ADDress ENDSCR EQU >02FE END of SCReen address LODFLG EQU >0371 Auto-boot needed flag START EQU >0372 Line to start execution at SYMBOL EQU >0376 Saved symbol table pointer SPGMPT EQU >0382 Saved PGMPTR for continue SBUFLV EQU >0384 Saved BUFLEV for contiue SEXTRM EQU >0386 Saved EXTRAM for continue * SAVEVP EQU >0388 Saved VSPRT for continue * ERRLN EQU >038A On-error line pointer BUFSRT EQU >038C Edit recall start addr (VARW) BUFEND EQU >038E Edit recall end addr (VARA) TABSAV EQU >0392 Saved main symbol table ponte SLSUBP EQU >0396 Saved LSUBP for continue SFLAG EQU >0398 Saved on-warning/break bits SSTEMP EQU >039A To save subprogram program ta SSTMP2 EQU >039C Same as above. Used in SUBPRO MRGPAB EQU >039E MERGEd temporary for pab ptr *---------------------------------------------------------- * Added 6/8/81 for NOPSCAN feature PSCFG EQU >03B7 *---------------------------------------------------------- * Flag 0: 99/4 console, 5/29/81 * 1: 99/4A console CONFLG EQU >03BB *---------------------------------------------------------- * Temporary NOTONE EQU >0374 NO-TONE for SIZE in ACCEPT us * in FLMGRS (4 bytes used) SAVEVP EQU >0388 ERRLN EQU >038A ACCVRW EQU >03AC Temoporary used in ERRZZ, als * used in FLMGRS VALIDP EQU >03B0 Use as two values passing fro VALIDL EQU >03B2 VALIDATE code to READL1 OLDTOP EQU >03BC Temporary used in ERRZZ, also CRNBUF EQU >0820 CRuNch BUFfer address CRNEND EQU >08BE CRuNch buffer END RECBUF EQU >08C0 Edit RECall BUFfer VRAMVS EQU >0958 Default base of value stack CNSTMP EQU >0390 Use as temporary stored place *********************************************************** * IMMEDITATE VALUES NUMBR EQU >00 NUMERIC validate LISTZ EQU >02 OLDZ EQU >05 RESEQZ EQU >06 SAVEZ EQU >07 MERGEZ EQU >08 DWNARR EQU >0A UPARR EQU >0B CHRTN EQU >0D OFFSET EQU >60 OSPACE EQU >20+OFFSET GKXB space plus offset * Bits in XFLAG REMODE EQU 0 REM only mode OPTFLG EQU 1 Option base declared flag FNCFLG EQU 2 Scanning UDF SUBFLG EQU 3 Scanning a subprogram STRFLG EQU 4 Scanning a string variable SAFLG EQU 5 Scanning subprogram arguments IFFLAG EQU 6 Scanning an if-statement ENTXFL EQU 7 ENTERX flag * * BITS IN FLAG * NUMBIT EQU >00 Autonum bit (Can't use MACRO) WRNPRT EQU 1 Warning print bit WRNSTP EQU 2 Warning stop bit *********************************************************** * Editting command equates BREAK EQU >02 Break key DLETE EQU >03 Delete key INSRT EQU >04 Insert key RECALL EQU >06 Edit-buffer recall CLRLN EQU >07 Clear-line key BACK EQU >08 Back-space key FORW EQU >09 Forward-space key DOWN EQU >0A Down-arrow key UPMV EQU >0B Up-arrow key *********************************************************** * IMMEDITE VALUES QUOTE EQU >22 " DOLLAR EQU >24 $ CURSOR EQU >1E+OFFSET CURSOR EDGECH EQU >1F+OFFSET EDGE character COMMA EQU >2C , DASH EQU >2D - GKXB COLON EQU >3A : GKXB *********************************************************** * PAB offset CZCLOS EQU 1 CLOSE CODE COD EQU 4 I/O code NLEN EQU 13 Length of file descriptor *********************************************************** * 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 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 Zpare token (LIBRARY) * EQU >AC Zpare token (REAL) * EQU >AD Zpare token (INTEGER) * EQU >AE Zpare token (SCRATCH) * EQU >AF Zpare 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 * EQU >CA spare token 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 VAL 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 to >E7 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) * EQU >F3 spare token (VARIABLE) * EQU >F4 spare token (RELATIVE) * EQU >F5 spare token (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 *********************************************************** TITL 'EDIT-359' *********************************************************** * GROM HEADER *********************************************************** GROM >6000 AORG 0 DATA >AA02,>0100,0,USER,0,LINK1,0,0 *********************************************************** * Branch table for routines in EDIT *********************************************************** BR AUTON G6012 BR TOPL15 BR INITPG BR SPRINT Initialize sprites. BR CHRTBL RXB CHRTBL BR TOPL10 G601C BR CHRTAB BR SZRUN BR $ Was GETLNB BR KILSYM BR $ Was CRUNCH BR GETNB BR GETNB2 BR GETCHR BR GETLN BR AUTO1 DATA TOPL02 BR EDITLN BR GRSUB1 Read from ERAM (use GREAD/VDP BR GWSUB Write a few bytes to ERAM/VDP * Error and system messages * BASE 0,0,>300,>300,0,0,>60 MSGERR BYTE >A9,>CE,>80,>A5,>D2,>D2,>CF,>D2 * In Error MSGFST BYTE >07,>B2,>C5,>C1,>C4,>D9,>80,>8A * Ready MSGBRK BYTE >0A,>A2,>D2,>C5,>C1,>CB,>D0,>CF,>C9,>CE,>D4 * Breakpoint MSGTA BYTE >B4,>D2,>D9,>80,>A1,>C7,>C1,>C9,>CE * Try Again MSGWRN BYTE >8A,>80,>B7,>C1,>D2,>CE,>C9,>CE,>C7 * * Warning MSG10 BYTE >10,>AE,>D5,>CD,>C5,>D2,>C9,>C3,>80 * Numeric BYTE >AF,>D6,>C5,>D2,>C6,>CC,>CF,>D7 * Overflow MSG14 BYTE >0C,>B3,>D9,>CE,>D4,>C1,>D8,>80,>A5,>D2,>D2,>CF * Syntax Error MSG16 BYTE >18,>A9,>CC,>CC,>C5,>C7,>C1,>CC,>80,>A1,>C6,>D4 * Illegal After BYTE >B3,>D5,>C2,>D0,>D2,>CF,>C7,>D2,>C1,>CD * Subprogram MSG17 BYTE >10,>B5,>CE,>CD,>C1,>D4,>C3,>C8,>C5,>C4,>80 * Unmatched BYTE >B1,>D5,>CF,>D4,>C5,>D3 * Quotes MSG19 BYTE >0D,>AE,>C1,>CD,>C5,>80,>B4,>CF,>CF,>80,>AC,>CF * Name Too Long MSG24 BYTE >16,>B3,>D4,>D2,>C9,>CE,>C7,>8D,>AE,>D5,>CD,>C2 * String-Number BYTE >AD,>C9,>D3,>CD,>C1,>D4,>C3,>C8 * Mismatch MSG25 BYTE >11,>AF,>D0,>D4,>C9,>CF,>CE,>80,>A2,>C1,>D3,>C5 * Option Base BYTE >A5,>D2,>D2,>CF,>D2 * Error MSG28 BYTE >14,>A9,>CD,>D0,>D2,>CF,>D0,>C5,>D2,>CC,>D9,>80 * Improperly BYTE >B5,>D3,>C5,>C4,>80,>AE,>C1,>CD,>C5 * Used Name MSG34 BYTE >16,>B5,>CE,>D2,>C5,>C3,>CF,>C7,>CE,>C9,>DA,>C5 * Unrecognized BYTE >A3,>C8,>C1,>D2,>C1,>C3,>D4,>C5,>D2 * Character MSG36 BYTE >0B,>A9,>CD,>C1,>C7,>C5,>80,>A5,>D2,>D2,>CF,>D2 * Image Error MSG39 BYTE >0B,>AD,>C5,>CD,>CF,>D2,>D9,>80,>A6,>D5,>CC,>CC * Memory Full MSG40 BYTE >0E,>B3,>D4,>C1,>C3,>CB,>80,>AF,>D6,>C5,>D2,>C6 * Stack Overflow MSG43 BYTE >10,>AE,>A5,>B8,>B4,>80,>B7,>C9,>D4,>C8,>CF,>D5 * NEXT Without BYTE >A6,>AF,>B2 * FOR MSG44 BYTE >10,>A6,>AF,>B2,>8D,>AE,>A5,>B8,>B4,>80 * FOR-NEXT BYTE >AE,>C5,>D3,>D4,>C9,>CE,>C7 * Nesting MSG47 BYTE >15,>AD,>D5,>D3,>D4,>80,>A2,>C5,>80,>A9,>CE * Must be in BYTE >80,>B3,>D5,>C2,>D0,>D2,>CF,>C7,>D2,>C1,>CD * Subprogram MSG48 BYTE >19,>B2,>C5,>C3,>D5,>D2,>D3,>C9,>D6,>C5,>80 * Recursive BYTE >B3,>D5,>C2,>D0,>D2,>CF,>C7,>D2,>C1,>CD,>80,>A3 * Subprogram Call MSG49 BYTE >0E,>AD,>C9,>D3,>D3,>C9,>CE,>C7,>80,>B3,>B5,>A2 * Missing Subend MSG51 BYTE >14,>B2,>A5,>B4,>B5,>B2,>AE,>80,>B7,>C9,>D4,>C8 * RETURN Without BYTE >80,>A7,>AF,>B3,>B5,>A2 * GOSUB MSG54 BYTE >10,>B3,>D4,>D2,>C9,>CE,>C7,>80 * String BYTE >B4,>D2,>D5,>CE,>C3,>C1,>D4,>C5,>C4 * Truncated MSG57 BYTE >0D,>A2,>C1,>C4,>80,>B3,>D5,>C2,>D3,>C3,>D2,>C9 * Bad Subscript MSG60 BYTE >0E,>AC,>C9,>CE,>C5,>80,>AE,>CF,>D4,>80,>A6,>CF * Line Not Found MSG61 BYTE >0F,>A2,>C1,>C4,>80,>AC,>C9,>CE,>C5,>80 * Bad Line BYTE >AE,>D5,>CD,>C2,>C5,>D2 * Number MSG67 BYTE >0E,>A3,>C1,>CE,>87,>D4,>80,>A3,>CF,>CE,>D4,>C9 * Can't Continue MSG69 BYTE >1A,>A3,>CF,>CD,>CD,>C1,>CE,>C4,>80 * Command BYTE >A9,>CC,>CC,>C5,>C7,>C1,>CC,>80,>C9,>CE,>80 * Illegal in BYTE >B0,>D2,>CF,>C7,>D2,>C1,>CD * Program MSG70 BYTE >17,>AF,>CE,>CC,>D9,>80,>AC,>C5,>C7,>C1,>CC,>80 * Only Legal BYTE >C9,>CE,>80 >C1,>80,>B0,>D2,>CF,>C7,>D2,>C1,>CD * in a Program MSG74 BYTE >0C,>A2,>C1,>C4,>80,>A1,>D2,>C7,>D5,>CD,>C5,>CE * Bad Argument MSG78 BYTE >12,>AE,>CF,>80,>B0,>D2,>CF,>C7,>D2,>C1,>CD * No Program BYTE >80,>B0,>D2,>C5,>D3,>C5,>CE,>D4 * Present MSG79 BYTE >09,>A2,>C1,>C4,>80,>B6,>C1,>CC,>D5,>C5 * Bad Value MSG81 BYTE >17,>A9,>D1,>C3,>C3,>D2,>D2,>C5,>C3,>D4,>80 * Incorrect BYTE >A1,>D2,>C7,>D5,>CD,>C5,>CE,>D4,>80,>AC,>C9,>D3 * Argument List MSG83 BYTE >0B,>A9,>CE,>D0,>D5,>D4,>80,>A5,>D2,>D2,>CF,>D2 * Input Error MSG84 BYTE >0A,>A4,>C1,>D4,>C1,>80,>A5,>D2,>D2,>CF,>D2 * Data Error MSG97 BYTE >14,>B0,>D2,>CF,>D4,>C5,>C3,>D4,>C9,>CF,>CE,>80 * Protection BYTE >B6,>C9,>CF,>CC,>C1,>D4,>C9,>CF,>CE * Violation MSG109 BYTE >0A,>A6,>C9,>CC,>C5,>80,>A5,>D2,>D2,>CF,>D2 * File Error MSG130 BYTE >09,>A9,>8F,>AF,>80,>A5,>D2,>D2,>CF,>D2 * I/O Error MSG135 BYTE >14,>B3,>D5,>C2,>D0,>D2,>CF,>C7,>D2,>C1,>CD,>80 * Subprogram BYTE >AE,>CF,>D4,>80,>A6,>CF,>D5,>CE,>C4 * Not Found MSG62 BYTE >0D,>AC,>C9,>CE,>C5,>80,>B4,>CF,>CF,>80,>AC,>CF * Line Too Long MSGFRE BYTE >A2,>D9,>D4,>C5,>D3,>80,>A6,>D2,>C5,>C5 * Bytes Free MSGSFR BYTE >A2,>D9,>D4,>C5,>D3,>80,>CF,>C6,>80,>B3,>D4,>C1 * Bytes of Stack BYTE >A6,>D2,>C5,>C5 * Free MSGGFR BYTE >A2,>D9,>D4,>C5,>D3,>80,>CF,>C6,>80,>B0,>D2,>CF * Bytes of Program BYTE >CD MSGGF1 BYTE >B3,>D0,>C1,>C3,>C5,>80,>A6,>D2,>C5,>C5 * Space Free MSGCIS BYTE >B5,>A4,>A6,>80,>B2,>C5,>C6,>D3,>80,>A9,>D4,>D3 * UDF Refs Itself MSGCF BYTE >A3,>C1,>CC,>CC,>C5,>C4,>80,>A6,>D2,>CF,>CD * Called From MSG56 BYTE >16,>B3,>D0,>C5,>C5,>C3,>C8,>80,>B3,>D4,>D2,>C9 * Speech String BYTE >B4,>CF,>CF,>80,>AC,>CF,>CE,>C7 * Too Long * BASE 0,0,>0300,>0300,0,0,0 USER DATA 0,TOPLEV BYTE 17 TEXT 'RXB VERSION 2001 ' DSCLOD BYTE 9 TEXT 'DSK1.LOAD' BYTE 0 SPCCHR BYTE >81,>00,>00,>00,>00,>00,>81,>00 * CURSOR CH DATA 0,0,0,0 * EDGE CHAR VDPREG BYTE >E0,>00,>20,>00,>06,>00 *********************************************************** * START OF BASIC INTERPETER *********************************************************** TOPLEV CLR V@>0370 Initialize temp area MOVE 77,V@>0370,V@>0371 * RXB MODULE PATCH CODE FOR RXB MODULE ******************** * ST 5,@KEYBD Select full keyboard * SCAN * CZ @KEYBD * BR G6388 99/4A Console? CALL CART * RXB PATCH CODE FOR CARTRIDE ST >01,V@CONFLG Select 99/4A console G6388 CLR @KEYBD * RXB MODULE PATCH CODE FOR RXB MODULE ******************** * DST NLNADD,V@BUFSRT Initialize edit-buffer start * DST NLNADD,V@BUFEND Initialize edit-buffer end MOVE 2,G@ATNZZ,@INTRIN Get address of ATNZZ AND >1F,@INTRIN Throw away the BR opcode DADD >5B,@INTRIN Address of polynomial constan * RXB PATCH CODE ************* ST >31,V@LODFLG indicate try auto-boot BR SZNEW AORG >03A5 *---------------------------------------------------------- * Add the following line for fixing "MEMORY FULL" error * occurring during MERGE execution will leave the file open * to disk DSR bug, 5/19/81 SZNEW CLR V@MRGPAB Initialize merged temporary * for PAB pointer *---------------------------------------------------------- ST RSTK,@SUBSTK Load base of subroutine stack CALL CHRTA2 Load character table CLR @FLAG Initialize flag byte DCLR @BUFLEV Initialize crunch buffer leve CALL CLSALL Close all open files CLR @DATA Initialize READ/DATA pointer DST VRAMVS,@VSPTR Initialize base of value stac DST @VSPTR,@STVSPT Save in permanent base DST @VSPTR,V@SAVEVP CALL INITPG Initialize program & s.t. CALL INTRND Initialize random number CZ V@LODFLG BS TOPL02 If need auto-boot * RXB PATCH CODE ************* * CLR V@LODFLG Won't ever need to do again BR G63D0 * RXB PATCH CODE ****************************************** AORG >03D0 G63D0 CALL AUTOLD Attempt an auto-boot * Label TOPL02 is used by auto-boot in detection of err ERRRDY EQU $ TOPL02 CALL G6A84 Say READY BYTE 0 * returns to TOPL15 TOPL05 CALL INITPG Initialize program space TOPL10 CALL KILSYM Kill the symbol table * RXB PATCH CODE ************* * TOPL15 AND >F7,@FLAG If error in UDF execution TOPL15 B MYSRCH G63E0 ST 5,@KEYBD Select full keyboard SCAN CLR @KEYBD TOPL20 ST RSTK,@SUBSTK Initialize subroutine stack TOPL25 DST NLNADD,@VARW Screen addr = lower left corn CLR @RAMFLG Clear the RAMFLG CLR @PRGFLG Make sure not in program mode * Check for auto-num mode CLOG >01,@FLAG If auto-num on BS TOPL35 DADD @CURINC,@CURLIN Generate new line number CGE 0,@CURLIN >32767? BS TOPL30 AND >FE,@FLAG If out of range->exit auto-nu B TOPL35 Merge in below * Must be a long branch!! TOPL30 DCEQ @ENLN,@STLN Line might exist BS G6412 DST @CURLIN,@FAC Ready for program search XML SPEED BYTE SEETWO * Search for existence of line BS EDTZ05 COND set = line found G6412 XML SCROLL Scroll to the next line DST @CURLIN,@ARG2 New line # CALL DISO Display the line number DINC @VARW Following by a space BR G6420 TOPL35 XML SCROLL Scroll the screen G6420 ST >9E,V@NLNADD-1 Display the prompt character CALL G6A76 Read in a line CALL SAVLIN Save input line for recall * Crunch the input line CLR @ERRCOD Assume no-error return DST CRNBUF,@RAMPTR Initialize crunch pointer XML CRUNCH CRUNCH the input line BYTE 0 * Normal crunch mode TOPL42 CASE @ERRCOD+1 BR TOPL45 No error detected BR ERRSYN *SYNTAX ERROR BR ERRBLN *BAD LINE NUMBER BR ERRLTL *LINE TOO LONG BR ERRNTL *NAME TOO LONG BR ERRNQS *UNMATCHED QUOTES BR ERRCIP *COMMAND ILLEGAL IN PROGRAM BR ERRIVN *UNRECOGNIZED CHARACTER TOPL45 DCZ @FAC Line # present BS TOPL55 CLOG >01,@FLAG Not AUTONUM BR G645B CEQ >0D,@RKEY Must be up or down BS G645B CEQ >01,@CHAT Start EDIT mode BR G645B B EDTZZ0 G645B CALL EDITLN EDIT the line into the progra BS TOPL25 If didn't change the line BR TOPL10 * Jump always TOPL55 CEQ >01,@CHAT If blank line - ignore BS TOPL25 CEQ >EB,V@CRNBUF BS SZSIZE CH >08,V@CRNBUF If imperative * GKXB Branch code for new commands DEL, COPY, and MOVE. BS NEWCMD Go here to test for new * keywords DST CRNBUF+1,@PGMPTR Anticipate usage of PGMCHR XML PGMCHR Prepare CHAT for OLD and SAVE CASE V@CRNBUF Select the keyword BR SZNEW NEW 0 BR SZCONT CONTINUE 1 BR SZLIST LIST 2 BR SZBYE BYE 3 BR SZNUM NUMBER 4 BR SZOLD OLD 5 BR SZRES RESEQUENCE 6 BR SZSAVE SAVE 7 BR SZMERG MERGE 8 * AUTO-BOOT - attempt a ----> RUN "DSK1.LOAD" AUTOLD MOVE 11,G@DSCLOD,V@CRNBUF DST CRNBUF,@PGMPTR DSK1.LOAD is in crunch buffer * RXB PATCH CODE ************* * BR SZRUNL Go to the RUN "NAME" CODE BR MYRUN ********************************* RUN ********************* SZRUN CEQ >C7,@CHAT Ready for 'RUN "NAME" ---- BR G64BF SZRUNL DST @PGMPTR,@FAC14 Save pointer to name XML PGMCHR Get the length of the string ST @CHAT,@FAC13 Put it in FAC13 CLR @FAC12 Make it a double byte DADD @FAC12,@PGMPTR Skip the string XML PGMCHR To see there is line no. ahea CALL G8024 Only RUN "NAME" ? BR ERRSYN No - junk on end so error ST STRINZ,@CHAT Prepare for LOAD routine DST @FAC14,@PGMPTR Restore the saved PGMPTR CALL OLD1 Load the program BR SZRUN0 Go ahead from here * No RUN "NAME" : just run the * current program in memory G64BF CEQ >C9,@CHAT Is there a line # after RUN? BR G64D5 XML PGMCHR Get the line number ST @CHAT,@FAC Put it in FAC for SEETWO XML PGMCHR ST @CHAT,@FAC1 XML PGMCHR Should be EOS now CALL G8024 Is it? BS SZRUN2 Yes - Go ahead from here * Just 'RUN' G64D5 CALL G8024 Should be EOS now BR ERRSYN No-SYNTAX ERROR SZRUN0 DCEQ @ENLN,@STLN Refuse without program BS ILLST DST @ENLN,V@START Defualt to beginning DSUB 3,V@START Offset into the table BR SZRUN1 Merge in below * Jump always SZRUN2 DCEQ @ENLN,@STLN Refuse without program BR G64F9 ILLST XML SCROLL Scroll the screen for message CLR @PRGFLG Prevent line # printing WRNNPP CALL G6A82 BYTE 29 * NO PROGRAM PRESENT BR TOPL15 * Condition can never be set since line 0 is prohibited G64F9 XML SPEED BYTE SEETWO * Find the line in the program BR ERRLNF * LINE NOT FOUND DST @EXTRAM,V@START Program run starts here * GKXB RUN code for color change. SZRUN1 BR RUNPAT Change colors. G6504 CALL CLSALL Close any open files DEC @PRGFLG Put it back in execution ST @RAMTOP+1,@RAMFLG Set/reset RAMFLG flag -- when DCLR V@SEXTRM in program mode & ERAM exist DCLR V@ERRLN Disallow CONTINUE after RUN CALL KILSYM Reset ERR handling to defualt ST RSTK,@SUBSTK Set the stack empty * RXB PATCH CODE ************ Turn off DSK#.LOAD search * SZRUN4 B G6A70 SZRUN4 B SCHOFF Turn off search first then G6 EDTZ05 B EDTZ00 **************************** CONTINUE ********************* SZCONT CALL GETNB Check for END-OF-LINE BR ERRSY1 Junk on end of command DCZ V@SEXTRM If can continue BS ERRCC XML SCROLL DST V@SEXTRM,@EXTRAM Copy old line table pointer DST V@SPGMPT,@PGMPTR Copy old text pointer DST V@SBUFLV,@BUFLEV Copy old buffer level DST V@SLSUBP,@LSUBP Copy last subprogram on stack OR V@SFLAG,@FLAG Restore on-warning/break bits G6540 DCH V@SAVEVP,@VSPTR While extra on stack BR G654A XML VPOP Pop them off BR G6540 G654A ST >FF,@PRGFLG Idicate program mode ST @RAMTOP+1,@RAMFLG Set/reset RAMFLG flag --- whe * in program mode & ERAM exist DCLR V@SEXTRM Prevent unauthorized CONTINUE DST VRAMVS,V@SAVEVP Init for program completion XML CONTIN Resume normal execution ERRCC CALL G6A84 Indicate error BYTE 25 * "* CAN'T CONTINUE" **************************** NUMBER *********************** *---------------------------------------------------------- * Fix NUMBER command cause XB goes into a loop displaying * *PROTECTION VIOLATION when a PROTECTED program is in * memory bug, add the following line after label SZNEW SZNUM CLOG >80,@FLAG Check PROTEDTION VIOLATION BR ERRPV *---------------------------------------------------------- CALL AUTON Get start line # and incremen OR >01,@FLAG Set AUTONUM bit for future us DST NLNADD,@VARW Initialize screen address BR TOPL30 Jump back into it * Jump always *********************************************************** * AUTON - scans the NUM, LIST and RES commands for line * numbers. Leaves 1st line number in CURLIN and 2nd line * number in CURINC. AUTON is entry point from NUM to defual * to 100,10 AUTON is entry point for LIST. *********************************************************** AUTON DST 100,@CURLIN Defualt start * GKXB AUTO4 label AUTO4 DST 10,@CURINC Defualt increment ST COMMA,@VARC Comma is the separator AUTO1 DDEC @VARW Don't miss the first characte * GKXB AUTO3 label AUTO3 CALL GETNB Get 1st character after keywo BS AUTO2 If end of line CALL GETLN Try to get a line number CZ @BYTES If digits gotten BS G658D DST @FAC,@CURLIN Set initial G658D CALL GETNB2 Allow spaces before separator DCH @VARA,@VARW Check end of line BS AUTO2 CEQ @VARC,@CHAT If not correct separator * GKXB Modification to the RES to allow renumbering a * portion of a program. BR CKLIST GKXB AUTON for record length. * GKXB AUTO5 label AUTO5 CALL GETNB Get char after separator BS AUTO2 If end of line CALL GETLN Try to get 2nd number CZ @BYTES If digits gotten BS G65A9 DST @FAC,@CURINC Save the increment G65A9 CALL GETNB2 Check EOL * GKXB Modification to the RES to allow renumbering a * portion of a program. BR RES2 GKXB AUTON for range check AUTO2 RTN *************************** SAVE ************************** SZSAVE DCEQ @ENLN,@STLN If no program BS ILLST B SAVE *************************** OLD *************************** SZOLD B OLD *************************** BYE *************************** SZBYE CALL CLSALL Properly close all files SZEXIT EXIT Return to MONITOR *************************** LIST ************************** SZLIST DCEQ @ENLN,@STLN Refuse LIST without prrogram BS ILLST B LIST LIST the program *************************** MERGE ************************* SZMERG B MERGE *************************** SIZE ************************** * RXB SIZE PATCH CODE ******** * SZSIZE CZ V@CRNBUF+1 Must have EOL SZSIZE B NSIZE BR ERRSYN G65CE XML COMPCT Garbage collect to free space DST @STREND,@ARG2 Get end of string space DSUB @VSPTR,@ARG2 Subtract stack pointer DSUB 63,@ARG2 Require 64-byte buffer GT If less then 64 bytes left BS G65DF DCLR @ARG2 Then indicate zero G65DF XML SCROLL Scroll the screen DST NLNADD+2,@VARW Begin a new line CALL DISO Display the number CZ @RAMTOP If no ERAM present BR G65F7 MOVE 10,G@MSGFRE,V@1(@VARW) BR G6621 G65F7 MOVE 19,G@MSGSFR,V@1(@VARW) XML SCROLL Scroll the screen DST NLNADD+2,@VARW Beginning of line DST @RAMFRE,@ARG2 Calculate space in ERAM DSUB CPUBAS-1,@ARG2 Subtract base CALL DISO Display the number MOVE 16,G@MSGGFR,V@1(@VARW) * RXB SIZE PATCH CODE ******** G6618 XML SCROLL MOVE 10,G@MSGGF1,V@NLNADD+4 G6621 XML SCROLL Scroll the screen * RXB SIZE PATCH CODE ******** * BR TOPL15 Return to top-level G6623 RTN RTN RXB wasted byte. ************************** RESEQUENCE ********************* SZRES DCEQ @ENLN,@STLN If no program BS ILLST * GKXB Modification to the RES command to allow renumbering * a portion of the program. CALL RES1 GKXB pickup of renage * GKXB RES6 label RES6 DST @XENLN,@FAC GKXB Compute # of increments DSUB @XSTLN,@FAC GKXB Actual number of lines - DSRL 2,@FAC Also takes care of this ^^^ DMUL @CURINC,@FAC Compute space taken by increm DCZ @FAC Bad line number BR ERRBLN DADD @FAC2,@CURLIN Compute highest address used CARRY Watch out for overflow BS ERRBLN CH >7F,@CURLIN Overflow is > 32767 BS ERRBLN ST @RAMTOP+1,@RAMFLG Set/reset RAMFLG to use PGMCH CLR @ARG4 To be used for double add * GKXB Modification to the RES command to allow renumbering * a portion of the program. CALL RES4 GKXB Check high line # for ov DST @>8370,@VAR0 Assume VDP-top CZ @RAMFLG But if ERAM exists BS G665F DST @RAMTOP,@VAR0 Top for ERAM G665F DINCT @PGMPTR Skip EOL and count G6661 XML PGMCHR VDP RAM or ERAM CEQ >C7,@CHAT Skip strings BS SEQZ2 CEQ >C8,@CHAT If numeric BR G6677 SEQZ2 XML PGMCHR Get next token (count) ST @CHAT,@ARG5 For double add DADD @ARG4,@PGMPTR Up to end of string BR G66AA G6677 CEQ >C9,@CHAT Check for line # BR G66AA CALL GRSUB2 Get the line # in the text BYTE PGMPTR * @PGMPTR : Source addr on ERAM DST @EEE1,@FAC8 Save it temporary place DST @CURLIN,@ARG2 Set for searching * GKXB Modification to the RES command to allow renumbering * a portion of the program. DST @XSTLN,@ARG GKXB New segment start G6689 CALL GRSUB3 Read the line # fromn ERAM * (use GREAD1) or VDP, reset * possible breakpoint too BYTE ARG * @ARG : Source addr on ERAM/VD DCEQ @EEE1,@FAC8 BS SEQZ3 DSUB @CURINC,@ARG2 Update new line # DADD 4,@ARG And entry in line # table * GKXB Modification to the RES command to allow renumbering * a portion of the program. DCH @XENLN,@ARG GKXB New segment end BR G6689 BR G66A8 GKXB Skip replacing undefined * line # with 32767 DATA >7FFF * GKXB unused bytes SEQZ3 CALL GWSUB Write a few bytes of data * @PGMPTR : Destination address on ERAM/VDP * @ARG2 : Data * 2 : Byte count BYTE PGMPTR,ARG2,2 G66A8 DINCT @PGMPTR Pass two byte line # in text G66AA DCLR @>83D6 Reset VDP timeout DCHE @VAR0,@PGMPTR And on end of program BR G6661 * Now update the line # table itself * GKXB Modification to the RES command to allow renumbering * a portion of the program. DST @XSTLN,@FAC GKXB New segment start DST @CURLIN,@ARG With start address off course G66B8 CALL GWSUB Write a few bytes of data to * ERAM (use GWRITE) or VDP * @FAC : Destination address on ERAM/VDP * @ARG : Data * 2 : Byte count BYTE FAC,ARG,2 DSUB @CURINC,@ARG Compute next line # DADD 4,@FAC And next entry in line # tabl * GKXB Modification to the RES command to allow renumbering * a portion of the program. DCH @XENLN,@FAC GKXB New segment end# table BR G66B8 CLR @RAMFLG Restore the ERAM flag * GKXB Modification to the RES command to allow renumbering * a portion of the program. BR RES5 GKXB find out where to return *********************************************************** * EDIT a line into a program * * Must be called with the following set up: * FAC = line number of line to be edited into program * CHAT = length of line * CRNBUF = crunched line *********************************************************** EDITLN CLOG >80,@FLAG Protection violation BR ERRPV CALL CLSALL Close any open files CALL KILSYM Kill symbol table CLR @STPT Restore STPT ST @CHAT,@STPT+1 *********************************************************** * @CHAT=1 ? YES : LINE NUMBER ONLY - GO TO DELETE THE LINE * NO : INSERT A NEW LINE OR REPLACE EXISTING LIN *********************************************************** CEQ >01,@CHAT Something besides line # BR INSREP CLOG >01,@FLAG Auto-number mode on BS G66F0 AND >FE,@FLAG Reset AUTONUM mode RTNSET CEQ @>8300,@>8300 Set condition bit RTNC And return G66F0 DCEQ @ENLN,@STLN If no program BS RTNSET *********************************************************** * EDITZ1 Delete the line # from line-#-buffer. * Delete the text from program text area. *********************************************************** EDITZ1 XML SPEED Try to find the given line # BYTE SEETWO BR RTNSET Return if not found XML DELREP Remove it's text from program * Delete the 4 bytes from the line # table DST @EXTRAM,@VARY2 Pointer to line pointer DINC @VARY2 Advance to last byte of entry DDECT @EXTRAM Point to first byte of entry DST @EXTRAM,@VAR0 DDEC @VAR0 Last byte of next line entry * Move down 4 bytes from here DSUB @STLN,@EXTRAM # of bytes to move down DCZ @EXTRAM BS G6714 DST @EXTRAM,@ARG Put in arg for MVDN XML MVDN Move one byte at a time G6714 DADD >04,@STLN New start addr of line # tab CZ @RAMTOP If ERAM not exist BR G6724 DCH @>8370,@STLN Delete the only line BS TOPL05 BR G672E With ERAM G6724 DCZ @STLN BS TOPL05 DCH @RAMTOP,@STLN BS TOPL05 G672E BR KILSYM Kill symbol table with return *********************************************************** * INSERT A NEW LINE OR REPLACE AN EXISTING LINE *********************************************************** * BUILD LINE # AND LINE POINTER IN VARY, +1, +2, +3, +4 INSREP DST @FAC,@VARY 2 bytes of line # DST @ENLN,@VARY2 Last address of line-#-table DST @ENLN,@EXTRAM Prepare to search the line # *********************************************************** * 1ST LINE IN MEMORY : EDITZ5 -- EDITZ6 -- EDITZ8 -- DONE *********************************************************** DCEQ @ENLN,@STLN 1st text? BS EDITZ5 *********************************************************** * EDITZ3 * COMPARE LINE # IN FAC WITH LINE # IN THE LINE # TABLE * EQUATE : --DELTX--EDITZ8-DONE * HIGHER : HIGHEST LINE? YES : EDITZ6--EDITZ8--DONE * NO : BACK TO EDITZ3 * LOWER : EDITZ4--EDITZ8--DONE *********************************************************** DINC @EXTRAM Get line EDITZ3 DSUB 4,@EXTRAM Go to next line in program CALL GRSUB1 Read from ERAM(use GREAD)/VDP BYTE EXTRAM * @EXTRAM : Source addr on ERAM * or VDP AND >7F,@EEE Reset possible breakpoint DCEQ @EEE,@FAC If #s match-delete old BS DELTX DST 4,@VARA For MEMFUL H New line # is greater BR G675E DCEQ @STLN,@EXTRAM Line to be inserted got the * highest line number in line * # table :: add to the end of * line-#table BS EDITZ6 BR EDITZ3 *********************************************************** * EDITZ4 * ALLOCATE SPACE IN LINE # TABLE BY MOVING * PART (ARG=4) OF THE LINE # TABLE UP *********************************************************** G675E DST 4,@ARG EDITZ4 DADD @EXTRAM,@ARG DSUB @STLN,@ARG # of bytes in between DST @STLN,@VAR9 Copy old start address of lin CALL MEMFUL Check for memory full DADD @STPT,@STLN CZ @RAMTOP BR G677E MOVE @ARG,V*VAR9,V*STLN Move line # table BR G6783 G677E DST @STLN,@VAR0 Destination address for MVUP XML MVUP Move the line # table up G6783 DST @ENLN,@VARY2 Set up line ptr in line # ent BR EDITZ8 *********************************************************** * EDITZ5 * EDITZ6 * SET UP 1ST ENTRY IN LINE # TABLE BY GIVING @VARA=3 * WHEN INSERT THE HIGHEST LINE : * CONCATENATE LINE # ENTRY TO LINE # TABLE *********************************************************** EDITZ5 DST >03,@VARA Subtract >03 from STLN(@>8370 * to get new start addr of tab EDITZ6 CALL MEMFUL Check for memory full DADD @STPT,@STLN Concatenate line # entry to DST @STLN,@EXTRAM table *********************************************************** * EDITZ8 * UPDATE ENTRY IN LINE # TABLE, PUT TEXT IN -- DONE *********************************************************** EDITZ8 EQU $ * Update the 4 bytes entry in line # table DINC @VARY2 Point to 1st token (not lengt DSUB @STPT,@VARY2 Set up the line pointer for V CALL GWSUB Write a few bytes of data to * ERAM (use GWRITE) or VDP * @EXTRAM : Destination address on ERAM/VDP * @VARY : Data * 4 : Byte count BYTE EXTRAM,VARY,4 *********************************************************** * Now insert the line's text between the line number table * and the rest of the program's text *********************************************************** ********** GET THE LENGTH OF LINE # TABLE IN @ARG ********* DST @ENLN,@ARG Highest addr for line # table DSUB @STLN,@ARG Total length of line # table DINC @ARG Add one for extra offset ****************** MOVE THE LINE # TABLE ****************** DST @STLN,@VAR9 Old start addr of line # tabl DINC @STPT Point to next free byte in VD DSUB @STPT,@STLN New entry to line # table DSUB @STPT,@ENLN CZ @RAMTOP If ERAM not exist BR G67C0 MOVE @ARG,V*VAR9,V*STLN Move line # table BR G67C5 G67C0 DST @STLN,@VAR0 Set up destination addr for M XML MVUP Move line # table ****************** WRITE THE LENGTH BYTE ****************** G67C5 DDEC @STPT Update length of text DDEC @VARY2 Point to the length byte CALL GWSUB Write a few bytes of data * to ERAM (use GWRITE) or VDP * @VAR2 : Destination address on ERAM or VDP * @(STPT+1) : Data * 1 : Byte count BYTE VARY2,STPT+1,1 DINC @VARY2 ********************* WRITE THE TEXT ********************** CZ @RAMTOP If ERAM not exist BR G67DE MOVE @STPT,V@CRNBUF,V*VARY2 Move text BR G67EA G67DE DST CRNBUF,@AAA Copy the text from crunch * buffer (which is on VDP) to ERAM DST @VARY2,@BBB DST @STPT,@CCC @CCC : Byte count XML VGWITE G67EA BR KILSYM Kill symbol table and return *********************************************************** * REPLACE AN EXISTING LINE ************** Compute length of old entry **************** DELTX DINCT @EXTRAM Point to the line pointer CALL GRSUB1 Read from ERAM (use GREAD)/VD BYTE EXTRAM * @EXTRAM : Source addr on ERAM DDECT @EXTRAM Restore back DDEC @EEE Point to the length byte CALL GRSUB1 Read the length from ERAM/VDP BYTE EEE * @EEE : Source addr on ERAM/VD ST @EEE,@VARA+1 CLR @VARA Make a double byte DNEG @VARA And get length difference CALL MEMFUL Check for memory full DADD @VARA,@STLN Update STLN XML DELREP Remove old text (same line #) DDECT @EXTRAM Correct pointer ******* SET UP THE LINE POINTER IN LINE # ENTRY *********** DST @ENLN,@VARY2 Prepare setting up line point BR EDITZ8 Go update entry in line # tab * and put text in *********************************************************** * SUBROUTINE TO READ 2 BYTES OF DATA FROM VDP OR ERAM * (use GREAD) *********************************************************** GRSUB1 FETCH @FFF Fetch the source addr on ERAM DST *FFF,@DDD Put it in @DDD CZ @RAMTOP If ERAM present BS G6823 DST 2,@FFF @FFF : Byte count XML GREAD Read data from ERAM * @EEE : Destination addr on CP BR G6827 ERAM not exists G6823 DST V*DDD,@EEE Read data from VDP G6827 RTN *********************************************************** * SUBROUTINE TO WRITE A FEW BYTES OF DATA TO VDP OR ERAM * (use GWRITE) *********************************************************** GWSUB FETCH @AAA Fetch the destination addr on DST *AAA,@AAA ERAM/VDP FETCH @BBB+1 Fetch the source addr on CPU * where data is stored CLR @BBB Make a double byte FETCH @CCC+1 Fetch the byte count CLR @CCC Make a double byte CZ @RAMTOP If ERAM exists BS G683E XML GWRITE Write the data to ERAM RTN G683E MOVE @CCC,*BBB+1,V*AAA Write to VDP RTN *********************************************************** * SUBROUTINE TO GET A NON-BLANK CHARACTER FROM LINE *********************************************************** GETNB CALL GETCHR Get a character BS RTNSET If end-of-line GETNB2 CEQ >20,@CHAT BS GETNB RTN *********************************************************** * SUBROUTNE TO GET A CHARACTER FROM LINE *********************************************************** GETCHR DCH @VARA,@VARW BS RTNSET ST V*VARW,@CHAT Put character in @CHAT CEQ >7F,@CHAT If not edge character BS G6864 SUB OFFSET,@CHAT >60 Screen character into ASCII DINC @VARW RTN G6864 DADD 4,@VARW Skip to next line BR GETCHR * Jump always *********************************************************** * GETLN - Gets an line number after a command and puts it * into the FAC. If the character in CHAT when it is called * is not in the legal numeric range (0-9) then GETLN * GETLN returns with no other action. * Called by: AUTON, RUN, EDITLN *********************************************************** GETLN DCLR @FAC Assume no number CLR @BYTES Assume no digits GETLN2 SUB >30,@CHAT ASCII to normal range CHE 10,@CHAT If numeric digit BS G6891 DMUL 10,@FAC Multiply by 10 DCZ @FAC Error if overflow BR GTLNER ST @CHAT,@FAC1 Need to add in this digit DADD @FAC2,@FAC Add accumulator into last dig DCGE 0,@FAC Error if overflow BR GTLNER INC @BYTES Got another digit CALL GETCHR Get the next character BR GETLN2 If not EOS G6891 CZ @BYTES If digits gotten BS G6899 DCZ @FAC If hit natural zero BS GTLNER G6899 ADD >30,@CHAT Put back into ASCII RTN GTLNER XML SCROLL Scroll the screen CLR @PRGFLG Don't print a line number BR ERRBLN * BAD LINE NUMBER MEMFUL DADD @STPT,@VARA Total # of bytes to be added * GKXB MEMFLL label MEMFLL DSUB @VARA,@STLN New STLN CZ @RAMTOP BS G68B5 DCHE CPUBAS,@STLN Not enough memory BR MEMZ1 RTN G68B5 DCHE VRAMVS+64+256,@STLN Memory full BS G68C2 MEMZ1 DADD @VARA,@STLN Back to old start line # tabl CALL G6A84 BYTE 11 * MEMORY FULL G68C2 RTN * Initialize program space INITPG CLR @RAMFLG Reset RAMFLG XML GDTECT Search for ERAM & select ROM DST @RAMTOP,@RAMFRE Initialize free pointer DST @>8370,@STLN Assume VDP - initialize STLN CZ @RAMTOP If ERAM is present BS G68D9 DST @RAMTOP,@STLN Initialize STLN for ERAM G68D9 DST @STLN,@ENLN Init ENLN based upon STLN * Kill the symbol table KILSYM DST @STLN,@FREPTR Assume VDP and init free poin DCEQ @>8370,@FREPTR BS G68E6 DDEC @FREPTR Back off 1 if program present G68E6 CZ @RAMTOP If ERAM exists BS G68FC DST @STLN,@RAMFRE Update the @RAMFRE DCEQ @RAMTOP,@RAMFRE BS G68F9 DDEC @RAMFRE Back off 1 if program present G68F9 DST @>8370,@FREPTR Initialize VDP free pointer G68FC DCLR @SYMTAB Kill symbol table DCLR @SUBTAB Kill subprogram table DST @FREPTR,@STRSP Initialize string space DST @STRSP,@STREND CLR @BASE Reset OPTION BASE to 0 DCLR V@SEXTRM Disallow CONTINUE DST VRAMVS,@STVSPT Initialize base of value stac DST @STVSPT,@VSPTR Initialize value stack pointe DST @VSPTR,V@SAVEVP Initialize pointer in VDP too RTN *********************************************************** * Data for the color tables (starts at >0800) * BYTE >D0,>00,>00,>00,>00,>00,>00,>00 * BYTE >00,>00,>00,>00,>00,>00,>00,>10 * BYTE >10,>10,>10,>10,>10,>10,>10,>10 * BYTE >10,>10,>10,>10,>10,>10,>10,>10 *********************************************************** CHRTA2 ALL >20+OFFSET Clear the screen DST >3567,@>83C0 Initialize random number gen MOVE 16,G@SPCCHR,V@>03F0 Cursor character * RXB PATCH CODE CHRTAB DST >0400,@FAC Address of chracater tables ST 95,@FAC2 Number of characters CALL CHRTBL RXB character loader BR G6939 * RXB SUB CODE FOR SIZE ****** SDISO DST NLNADD+2,@VARW * CALL DISO * RTN * ****************************** G6939 BACK 4 Border color = BLUE CLR V@>0800 MOVE 14,V@>0800,V@>0801 ST >F0,V@>080F WHITE fore/transparent back MOVE 16,V@>080F,V@>0810 CALL SPRINT * This part might be moved up later, load special character * here. Don't load before hiding all sprites. MOVE 6,G@VDPREG,#1 RTN * ****** Initialization of sprites. Enable 28 sprites. ****** * SPRINT CLR V@>0780 Clear motion of all sprites MOVE >6F,V@>0780,V@>0781 * Replace the line for speeding up XB. 5/22/81 * ST 28,@MOTION All in motion CLR @MOTION All not in motion ST >D0,V@>0370 Sprites 29 to 32 unavailiable DST >C000,V@>0300 Hide the first sprites DCLR V@>0302 Make first sprite transparent MOVE 108,V@>0300,V@>0304 Ripple for the rest RTN * * ERROR messages in this file * ERRSY1 CLR @PRGFLG Without a line number ERRSYN CALL G6A84 BYTE 3 * SYNTAX ERROR ERRNQS XML SCROLL Scroll up the screen CALL G6A84 EOL before end of string BYTE 5 * UNMATCHED QUOTES message ERRNTL CLR @PRGFLG Don't print a line # CALL G6A84 BYTE 6 * NAME TOO LONG ERRLNF CALL G6A84 BYTE 22 * LINE NOT FOUND ERRBLN CALL G6A84 BYTE 23 * BAD LINE NUMBER ERRLTL CLR @PRGFLG Don't print line number CALL G6A84 Issue the error BYTE 24 * LINE TOO LONG ERRCIP XML SCROLL Scrolling the screen CALL G6A84 BYTE 26 * COMMAND ILLEGAL IN PROGRAM ERRPV CALL G6A84 BYTE 39 * PROTECTION VIOLATION ERRIVN CLR @PRGFLG Don't print line number CALL G6A84 BYTE 40 * UNRECOGNIZED CHARACTER * * Other ERROR messages in the program * * ERRRDY * READY BYTE 0 * ERRMEM * MEMORY FULL BYTE 11 * ERRCC * CAN'T CONTINUE BYTE 25 * WRNNPP * NO PROGRAM PRESENT BYTE 29 *********************************************************** * RXB SIZE NSIZE CZ @PRGFLG * PROGRAM MODE? BR CSIZE CZ V@CRNBUF+1 * NORMAL BR ERROLP CALL SIZEAS BR TOPL15 CSIZE CALL CHKEND * CALL SIZE CALL SIZEAS CALL RETURN SIZEAS CALL G65CE CZ @RAMTOP BS AMSSIZ MOVE 6,@>2002,@FAC DCEQ >AA55,@FAC+4 BR AMSSIZ DST @FAC+2,@ARG2 DSUB @FAC,@ARG2 CALL SDISO MOVE 17,G@MESSAG,V@1(@VARW) CALL G6618 B AMSSIZ *********************************************************** AORG >0A70 G6A70 BR PRESCN BR $ Spare BR LLIST G6A76 BR READLN BR CHKEND check End Of Statement BR $ Was SEETWO - now spare G6A7C BR DISO BR ENTER BR ENT09 G6A82 BR WARNZZ G6A84 BR ERRZZ G6A86 BR READL1 BR READ00 BR READL3 BR $ Spare *********************************************************** * READLN - Read one logical line (up to four physical lines * from the keyboard. Interpret things like BACKSPACE, * INSERT, DELETE AND FORWARD. The total number of character * can be limited by changing the start value for ARG2 * (upper limit), and entering at READL1 and VARW has to * contain the start address of the feild, and VARA the * current highest wirte address. Entering at READ00 allows * for specification of the intial cursor-position. In this * case ARG5 has to be set to the cursor-position. Please se * to it that VARA, VARW, ARG2, and ARG4 have consistent * values, i.e. * VARW <= ARG5 <= VARA <= ARG2 * ARG4 indicates if the line has been changed. If so, it * contains a 0. If you enter READLN through READ00, you hav * to initialize ARG4 to a nonzero value, should you want to * use this feature. *********************************************************** *---------------------------------------------------------- * Fix "You cannot add characters to a line whose number is * multiple of 256, if that line was reached by typing eithe * an up arrow or a down arrow form a previous line" bug, * replace following 3 lines: * READLN ST >FF,@ARG7 Indicate non-check mode * DST >037D,@ARG2 Set default upper limit * DST @VARW,@VARA Default nothing entered yet * with READLN DST >057D,@ARG2 Set default upper limit DST @VARW,@VARA Default to nothing entered ye READL3 ST >FF,@ARG7 Indicate non-check mode *---------------------------------------------------------- * Please make sure that VARA points at a space location, or * at the end-of-field. *-------------- ADD FOLLOWING LINES 6/12/81 --------------- READL1 CLR V@NOTONE Reset flag for ACCEPT SIZE to ST 1,@ARG4 This means "no change" in lin READL2 DST @VARW,@ARG5 Position cursor at start of f *---------------------------------------------------------- * Auto-repeat function is added for 99/4A, in PSCANS line * READ00 to READZ2+1 are changed to following code *---------------------------------------------------------- READ00 CLR @VAR0 Counter for auto-repeat fucti * * To get out of insert mode, we usually return here. * READ01 CLR @ARG8 Indicate normal operation mod ST CURSOR,@VARV Use VARV for CURSOR/CHARACTER * Idicate one character and alternate current character * position between normal and cursor. READZ1 EX @VARV,V*ARG5 By alternating between the * normal character and the * cursor, we make the cursor CLR @TIMER blink * RXB PATCH CODE FOR USER ***** * G6AAE SCAN Scan for a character * RAND 99 Force randomize to be rando G6AAE CALL DUSER USER from EDIT mode BS READZ2 Found one!!!! G6AB3 INC @VAR0 Increment the auto-repeat cou CEQ >FF,@RKEY It is an old key BS G6AC5 CHE >FE,@VAR0 Hold old key for a while BR G6AC5 SUB 30,@VAR0 Control repeat rate B READZ5 G6AC5 CH >10,@TIMER Time next character switch BR G6AAE BR READZ1 Restart character blink cycle * * Correct if we ended up with a displayed cursor * READZ2 CLR @VAR0 READZ5 CEQ CURSOR,@VARV Will have to change once more BS G6AD7 EX @VARV,V*ARG5 Exchange for current cursor * GKXB key routines CTRL up, down, left, right G6AD7 B CTRLS GKXB CTRL KEYS BS G6BD0 * * BREAK character handling comes first * G6ADC CEQ BREAK,@RKEY Saw break character BR G6AF4 AND >FE,@FLAG Reset AUTONUM mode CZ @PRGFLG If in run mode BS BTOP15 *---------------------------------------------------------- * FIX FCTN4 breaks a program during an execution of INPUT, * ACCEPT, or LINPUT statement regardless of ON BREAK NEXT * flag bug 5/19/81 * Replace following 2 lines: * DST @SMTSRT,V@SPGMPT Save place for continue * B EXEC6D Interrupt execution * with: CLOG >40,@FLAG If ON-BREAK-NEXT has not been BR G6AF4 set, i.e. break is illegal DST @SMTSRT,V@SPGMPT Save place for continue B EXEC6D Interrupt execution *---------------------------------------------------------- * * Edit buffer recall * * RXB PATCH CODE ************ USER PATCH * G6AF4 CEQ RECALL,@RKEY If edit recall G6AF4 CEQ >FF,@RKEY NO KEY---SO NEVER USE BR G6B2A CZ @PRGFLG Ignore if exec mode BR READZ1 AND >FE,@FLAG Reset AUTONUM DST NLNADD+32,@VARW Initialize to 32 below screen G6B04 XML SCROLL Scroll the screen DSUB 32,@VARW Line start is 32 lower now DCEQ V@BUFSRT,@VARW Until reach recall start BR G6B04 DST V@BUFEND,@VARA Set old end of line DST @VARA,@FAC Calculate length of old line DSUB @VARW,@FAC Subtract start from end BS READZ3 If no characters to recall * RXB PATCH CODE FOR USER **** * MOVE @FAC,V@RECBUF,V*VARW Recall line MOVE @FAC,V*VARW,V*VARW READZ3 ST >FF,@ARG7 Non-check mode DST @VARW,@ARG5 Cursor at beginning of line BR READ00 Allow edit of line * * BACK-ARROW - Space back one position * G6B2A CEQ BACK,@RKEY Backup to previous position BS RBACK * * RIGHT-ARROW - Forward space * CEQ FORW,@RKEY Space one position BS RFORW * * INSERT - Start INSERT mode here * CEQ INSRT,@RKEY Set INSERT flag BR G6B3C ST 1,@ARG8 Select INSERT mode * * DELETE - Delete the current character * G6B3C CEQ DLETE,@RKEY DELETE all right BR G6B94 *------------ ADD THE FOLLOWING LINE 6/12/81 -------------- CLR V@NOTONE Reset flag for SIZE in ACCEPT CLR @ARG4 Indicate definite change in l DCEQ @ARG5,@VARA Not an empty line BS G6B8E CEQ EDGECH,V*VARA If pointing at end BR G6B53 DDEC @VARA Backup up onto line G6B53 DST @VARA,@ARG Move everything from right DSUB @ARG5,@ARG of the cursor to the left MOVE @ARG,V@1(@ARG5),V*ARG5 DST @ARG5,@ARG Start at the beginning AND >FC,@ARG1 OR >1D,@ARG1 Move over to the end of the l G6B69 DCHE @VARA,@ARG Update all errors BS G6B7A EX V*ARG,V@4(@ARG) Restore edge characters DADD 32,@ARG Next victim please BR G6B69 G6B7A DDEC @VARA Pre-update end of string CEQ EDGECH,V*VARA Hit edge character BR G6B86 DSUB 4,@VARA Skip over edge characters * For auto-repeat function 5/19/81 G6B86 CEQ >20+OFFSET,V*VARA BS READ01 DINC @VARA Locked at feild position G6B8E ST >20+OFFSET,V*VARA Clear last position BR READ01 * * CLEAR - Clear the entire input line * G6B94 CEQ CLRLN,@RKEY Found CLEAR command BR G6BB3 *-------------- ADD THE FOLLOWING LINE 6/12/81 ------------ CLR V@NOTONE Reset flag for SIZE in ACCEPT * Current maximum to minimum G6B9C CEQ >7F,V*VARA Don't clear edges BS G6BA6 ST >20+OFFSET,V*VARA Blank line G6BA6 DDEC @VARA Pre-update end-of-line DCHE @VARW,@VARA Up to and including first pos BS G6B9C DINC @VARA Undo last subtraction CLR @ARG4 Indicate change BR READL2 And restart everything * General exit point. Unidentified control codes don't have * effect!!!!! G6BB3 CEQ CHRTN,@RKEY Only react on CR/UP/DOWN BS G6BC2 CEQ UPMV,@RKEY BS G6BC2 CEQ DOWN,@RKEY BR READZ1 G6BC2 DCEQ @ARG2,@VARA Check for block on last posit BR G6BCF CEQ >20+OFFSET,V*VARA Blocked. . . . . . BS G6BCF DINC @VARA Point beyond last character i * line G6BCF RTN ENTER the current line G6BD0 CZ @ARG7 Check value of RKEY against g BR VALIZ9 DST V@VALIDP,@ARG Pick up the standard stuff ST V*ARG,@ARG V@VALIDP : Pointer to the * standard stuff CLOG >04,@ARG Specified UPPER CASE BS G6BF0 CH >5A,@RKEY Z too high for anything BS VALIZ2 CHE >41,@RKEY A already in range BS VALIZ9 CEQ >20,@RKEY SPACE allow spaces in UALPHA BS VALIZ9 G6BF0 CLOG >01,@ARG Specified NUMERIC BS G6C0B CEQ >45,@RKEY E ? BS VALIZ9 CEQ >2E,@RKEY . ? BS VALIZ9 CEQ >2B,@RKEY + ? BS VALIZ9 CEQ >2D,@RKEY - ? BS VALIZ9 BR VALIZ1 now try DIGIT range G6C0B CLOG >02,@ARG Digit range selected BS VALIZ2 VALIZ1 CHE >30,@RKEY 0 ? BR VALIZ2 No good CHE >3A,@RKEY 9 ? BR VALIZ9 Numeric allright VALIZ2 DST V@VALIDP,@ARG Copy start address of string ST V@VALIDL+1,@FAC6 and string length BR VALIZ4 now test given characters VALIZ3 CEQ V*ARG,@RKEY valid!!!! BS VALIZ9 VALIZ4 DINC @ARG Update actual address DEC @FAC6 and count # of characters BR VALIZ3 G6C30 CZ @PRTNFN Wait for completion of previo BR G6C30 tone, and then CALL TONE2 ---BEEP--- BR READZ1 Continue in whatever mode we' * in now VALIZ9 CZ @ARG8 INSERT mode? BS G6C91 * INSERT - is COMPLICATED!!!!! Because of those edge charac * Shift up all things. . . . continue as a standard insert * VARA <= ARG2 DCEQ @ARG2,@VARA If end of screen BS READZ4 *---------------------------------------------------------- * Fix Editing a line that has been retrived by the REDO key * and may garble the last few characters bug, 5/28/81 CEQ EDGECH,V*VARA If at end of line BR READZ4 DCEQ >02FE,@VARA If also at end of screen BR G6C64 XML SCROLL Scroll the screen DSUB 32,@VARW Back up line start address DSUB 28,@VARA Back up to current start line DSUB 32,@ARG2 Absolute high limit backs up DSUB 32,@ARG5 Current cursor position too B READZ4 G6C64 DADD 4,@VARA Skip to next line *---------------------------------------------------------- READZ4 DST @VARA,@ARG Use ARG as temp for insert G6C6B DCH @ARG5,@ARG Move everything up to current * line BR G6C8A DDEC @ARG Copy lower location to higher ST V*ARG,V@1(@ARG) Going from high to low CEQ EDGECH,V*ARG Bumped into wall again BR G6C88 DSUB 4,@ARG Skip the wall ST V*ARG,V@5(@ARG) And move character over G6C88 BR G6C6B G6C8A DCHE @ARG2,@VARA Only update VARA if upper BS G6C91 DINC @VARA hasn't been reached yet G6C91 ADD OFFSET,@RKEY Create displayable character ST @RKEY,V*ARG5 Display at current character * position CLR @ARG4 Indicate change in line READ05 DCEQ @ARG2,@ARG5 Hit right margin BR G6CAD CZ V@NOTONE If not the first time BS G6CA7 CALL TONE1 ---BEEP--- G6CA7 ST >FF,V@NOTONE Set the flag BR READZ1 Stay in current mode !!!! G6CAD DINC @ARG5 Update current address CEQ EDGECH,V*ARG5 Correct for next line BR G6CB9 DADD 4,@ARG5 By skipping border G6CB9 DCH @VARA,@ARG5 Check for last new high limit BR G6CC1 DST @ARG5,@VARA Update new high limit G6CC1 DCHE >02FE,@VARA Still some space to go BR READZ1 XML SCROLL Scroll the screen!!! DSUB 28,@VARA Back to current start of line CZ @ARG8 If not insert mode then BS G6CD5 DSUB 4,@VARA Off by 4 more-correct it G6CD5 DSUB 32,@VARW Backup line start address DSUB 32,@ARG2 Absolute high limit backs up DSUB 32,@ARG5 Current cursor position too BR READZ1 Start with something else * * Something special for forward cursor move * RFORW CLR @ARG8 Leave INSERT mode - don't cop BR READ05 but use rest of input logic *---------------------------------------------------------- * RBACK section has been moved from READL2+1 for adding * auto-repeat function in 99/4A. Also * BR READ01 is added at the end, 5/18/81 *---------------------------------------------------------- * This will cause the next test to fail initialy, since * VARW clearly equals ARG5 first time through *------------- ADD THE FOLLOWING LINE 6/12/81 ------------- RBACK CLR V@NOTONE Reset flag for SIZE in ACCEPT DCH @VARW,@ARG5 The standard backup entry BR G6CFB DDEC @ARG5 So we backup the current posi CEQ EDGECH,V*ARG5 Skip border line BR G6CFB DSUB 4,@ARG5 Backup to previous line G6CFB BR READ01 Go back for next character *********************************************************** * WARNZZ - Checks the special warning handling conditions * which can be set by an ON WARNING statement and does the * following based upon those conditions: * ON WARNING PRINT - prints continues execution * ON WARNING STOP - prints and stops * ON WARNING NEXT - ignores the warning and goes on *********************************************************** WARNZZ DCLR @ERRCOD Clear the error if form 9900 CLR @EXPZ FETCH @EXPZ+1 Get index into error table DSLL 2,@EXPZ Multiply by 4 DADD ERRTAB,@EXPZ Get addres of entry into tabl MOVE 4,G@0(@EXPZ),@FAC10 CZ @PRGFLG If its imperative BS WRNZZ3 take defualt. CLOG >02,@FLAG If print turned on BR G6D35 WRNZZ3 XML SCROLL Scroll the screen MOVE 9,G@MSGWRN,V@NLNADD * WARNING XML SCROLL Scroll the screen again DST NLNADD+2,@VARW Start address behind warning CALL TRACBK Check for warning in UDF BS WRNZZ5 Was UDF so message already ou CALL ERPNT5 Print the message WRNZZ5 ST 3,@XPT * If imperative then continue on normally G6D35 CZ @PRGFLG If its imperative BR G6D3C B RETNOS * If warning continue turned on the continue G6D3C CLOG >04,@FLAG If contiue BR ERRZZ4 B RETNOS ERRZZ4 CALL CLEAN Clean up stack and s.t. ERRZZ5 DST V@SAVEVP,@VSPTR Restore value stack BTOP15 B G6012 Finish up and go back *********************************************************** * ERRZZ - Sets up an error stack entry based upon the * information passed to it by the caller and what it can * gather from the error table. It then either prints the * error message and aborts or goes to the line specified by * a previously executed ON ERROR statement. The stack enrry * looks like: * --------------------------------------------------------- * | Error code | Severity | >69 | Luno # | EXTRAM | PGMPTR * | ^ | ^ | ^ | ^ | ^ | ^ * | FAC | FAC1 | FAC2| FAC3 | FAC4 | FAC6 *---------------------------------------------------------- * ERROR CODE - the error number * SEVERITY - Severity of the error * 1 - Warning * 5 - Possibly recoverable * 9 - Fatal, unrecoverable * >69 ERROR STACK ENTRY ID * LUNO # - Luno # if file error or -1 if non-file error * EXTRAM, PGMPTR - Information to indicate the line # of * the error *********************************************************** *---------------------------------------------------------- * In order to fix MEMORY FULL error occurring during MERGE * execution will leave the file open to disk DSR bug, * following lines should be added, *??????? ????????????????????? ???????????????? ??????????? * This note for the reshipment of FLMGR after 6/10/81 * IOCALL routine are copied from FLMGR here, becuase FLMGR * is not in the branch table in FLMGR. *??????? ????????????????????? ???????????????? ??????????? * ERRZZ DST V@MRGPAB,@PABPTR * DCZ @PABPTR Error must occur in EDITLN * routine during MERGEing * BS HERE * CALL IOCALL Close all files * DATA CZCLOS * HERE ...........program continues * A statement BR IOCALL needs to be added in FLMGRS, which * is not going to be reshipped at this time 6/10/81 * Therefore, the following patch is used *?????????????????????????????????????????????????????????? ERRZZ DEX V@MRGPAB,@PABPTR DCZ @PABPTR Error must occur in EDITLN * routine during MERGEing BS G6D74 MOVE 30,@FAC,V@>03C0 Save FAC area DST @PABPTR,@FAC12 Get the PAB pointer in FAC DADD NLEN,@FAC12 Compute name length entry ST 1,V@4(@PABPTR) * Select name length entry CALL CALDSR Call actual DSR line routine BYTE 8 MOVE 30,V@>03C0,@FAC * Ignore the error coming back from DSR DCLR @PABPTR Clear V@MRGPAB in case * any kind of I/O operation * following MERGE * (Also for the DEX statement) G6D74 DEX V@MRGPAB,@PABPTR Get the PABPTR back *---------------------------------------------------------- DCLR @ERRCOD Clear error code if from 9900 DSUB @CURINC,@CURLIN Just in case in autonum mode DCEQ CRNBUF,@SYMTAB If prescanning r.h. BR G6D87 of UDF and parameter in DST V@CRNBUF+2,@SYMTAB crunch buffer, fix SYMTAB G6D87 CLR @EXPZ Get index into error table FETCH @EXPZ+1 Get index into error table DSLL 2,@EXPZ Multiply index by 4 DADD ERRTAB,@EXPZ Address of table entry MOVE 4,G@0(@EXPZ),@FAC10 Get table entry ST RSTK+2,@SUBSTK Init subroutine stack but all * for GROM return address CZ @FAC13 If message only BR G6DAF ERRZZR CALL ERPRNT Display the error message DCEQ MSGFST,@FAC10 If * READY * BR G6DAD CALL CLSALL Close all files G6DAD BR ERRZZ4 and clean up G6DAF CZ @PRGFLG If imperative-default BS ERRZ1 DCZ V@ERRLN If error turned off BR G6DBF ERRZ1 CALL TRACBK Check for UDF BS ERRZZ4 Was UDF, message already out BR ERRZZR Assume normal error * * Error turned on. Now build the error entry * G6DBF CALL CLEAN Clean up the stack DST @FAC12,@FAC Put in error & severity ST >69,@FAC2 Error stack ID DCEQ MSG130,@FAC10 If I/O error BR G6DD6 ST V@2(@PABPTR),@FAC3 * Put in LUNO # OR >80,@FAC1 And indicate an I/O error G6DD6 DST @EXTRAM,@FAC6 Save line pointer DST @SMTSRT,@FAC4 Save pointer to beginning of * statement DST @VSPTR,@ARG Must check for room on stack DADD 24,@ARG Need 24 to help out VPUSH DCH @ARG,@STREND If not room BS G6DFD CALL ERPRNT Put out the message anyway DST MSG39,@FAC10 Memory full message CLR @PRGFLG Don't print a line # CALL ERPRNT Print it too MOVE 8,G@MSGERR,V@NLNADD-18 BR ERRZZ5 And give up G6DFD XML VPUSH Push the error entry DCLR @EXTRAM Clear on-error entry DEX V@ERRLN,@EXTRAM Set line pointer & clear on-e CALL GRSUB2 Read the line text pointer VD * ERAM (use GREAD1) or VDP BYTE EXTRAM * @EXTRAM : Source address * in ERAM/VDP DST @EEE1,@PGMPTR Put the result in @PGMPTR XML CONTIN And go to the line *********************************************************** * ERPRNT - Print an error or warning message * * ERPRNT - Entry point for ERROR * ERPNT5 - Entry point for WARNING *********************************************************** ERPRNT CALL G601C Load the character table XML SCROLL Scroll the screen ST >2A+OFFSET,V@NLNADD Put the * in DST NLNADD+2,@VARW Set up for the message ERPNT5 CLR @KEYBD Enable main console MOVE 1,G@0(@FAC10),@ARG1 Get message length CLR @ARG MOVE @ARG,G@1(@FAC10),V*VARW Display DADD @ARG,@VARW Start location for " IN " DCEQ MSG130,@FAC10 "* I/O ERROR [xx]xy" BR G6E4D DINC @VARW Update for one space * separation ST V@>04(@PABPTR),@ARG3 * Create high order resu CLR @ARG2 Only display high order decim CALL DISO Display this number ST V@>05(@PABPTR),@ARG3 * Get low order result SRL 5,@ARG3 Remove mose identification bi CALL DISO Output the number in decimal G6E4D DCEQ MSGFST,@FAC10 BS G6E79 CALL TONE2 Wake up the idiot!!!! CZ @PRGFLG If program, print line # BS G6E79 DCH >02F6,@VARW It will pass EOL BR G6E66 XML SCROLL Display on next line DST NLNADD+1,@VARW Indent for the "IN" G6E66 DST >C9CE,V@1(@VARW) * Put in the "in" DADD 4,@VARW Display location for line ST @CHAT,@EXPZ ASC destroys CHAT CALL ASC DISPLAY THE LINE # ST @EXPZ,@CHAT Restore CHAT G6E79 XML SCROLL RTN *********************************************************** * LLIST - Lists one program line on the screen. The * entrypoint to the line is given in STPT. * In this routine, FAC2 is used as a flag to indicate that * the most recent character output was an alphanumeric * character. If the next character is also an alphanumeric * character, then the two are separated by a space. *********************************************************** LLIST CLOG >80,@FLAG If program protected BS G6E85 CALL ERRZZ * PROTECTION VIOLATION BYTE 39 G6E85 CALL OUTREC Make room for a new line DST V*EXTRAM,@ARG2 Prepare for line # printing AND >7F,@ARG2 Reset possible BreakPoint CALL OUTLN Diplay line in free format DST @CCPADD,@VARW Copy position for editing DINC @VARW Leave room for space DST V@2(@EXTRAM),@PGMPTR * Get pointer to line LLISZ0 DST >0020,@FAC2 Clear blank fill and set spac LLIZ12 XML PGMCHR Get next token on line CZ @CHAT Exit on end of line BS LLISZ9 CZ @FAC3 If separator needed BS LLIZ15 EX @CHAT,@FAC3 Save CHAT and bare the separa CALL DSPCHR Put the separator out EX @CHAT,@FAC3 Restore CHAT * Next thing to determine is whether or not we need a space * for separation with the next stuff. LLIZ15 CLR @FAC3 Assume we'll get alphanumeric CEQ SSEPZ,@CHAT If double-colon BS LLIZ16 CEQ COLONZ,@CHAT If colon now and colon BR G6EC4 LLIZ16 CEQ COLONZ,@FAC before-separater BS LLIZ17 G6EC4 CHE COMMAZ,@CHAT Figure out separator range BR G6ECE CHE ORZ,@CHAT BR LLISZ2 G6ECE CH NOTZ,@CHAT Figure out separator range BR G6ED8 CHE NUMCOZ,@CHAT BR LLISZ2 G6ED8 ST >20,@FAC3 Prepare for alfa indication CZ @FAC2 alfanum-alfanum combination BS LLISZ2 CEQ >20,@FAC10 Don't ouput 2 spaces BS LLISZ2 LLIZ17 ST @CHAT,@FAC2 Save CHAT somewhere ST >20,@CHAT And display a space CALL DSPCHR ST @FAC2,@CHAT Retrive CHAT LLISZ2 EX @FAC3,@FAC2 Could be for the next time to * That takes care of all the extra spaces we might need CLOG >80,@CHAT Just copy variable names BR G6F0A G6EF8 CALL DSPCHR Copy the character to output XML PGMCHR Get the next character CZ @CHAT But exit on EOL BS LLISZ9 CLOG >80,@CHAT BS G6EF8 CLR @FAC No spaces if ":" or "::" BR LLIZ15 G6F0A CEQ NUMZ,@CHAT BS G6F17 CEQ STRINZ,@CHAT BR LLISZ3 CALL DSPQUO Display first quote of string * This place is the general location for strings both quote * unquoted. G6F17 XML PGMCHR Get string length in CHAT ST @CHAT,@FAC Copy in temporary space G6F1C CZ @FAC Also take care of empty strin BS G6F35 XML PGMCHR CZ @FAC2 Alpha means unquoted string BR G6F2E CEQ QUOTE,@CHAT BR G6F2E CALL DSPCHR Display two quotes for one G6F2E CALL DSPCHR Display 2nd quote or char DEC @FAC Update string length, get nex BR G6F1C G6F35 CZ @FAC2 BR LLISZ1 Non-alfa end means extra CALL DSPQUO Display closing quote ST >20,@FAC2 Cause space before following BR LLISZ1 alpha * Try to decode line numbers and keywords LLISZ3 CEQ LNZ,@CHAT Decode line # BR G6F55 XML PGMCHR Get the high order byte first ST @CHAT,@ARG2 XML PGMCHR ST @CHAT,@ARG3 information as collected her CALL OUTLN Display the actual informatio BR LLISZ1 And continue * Now it has to be a normal keyword G6F55 DST KEYTAB,@FAC Address of KEYTAB for search XML IO Search keyword table BYTE 0 * Select table search * FAC8 returns with pointer to keyword * FAC4 has length LLISZ6 MOVE 1,G@0(@FAC8),@CHAT * And output the thus found character CALL DSPCHR Display character on screen DINC @FAC8 Update FAC8 for next referenc DEC @FAC5 Count number of characters BR LLISZ6 Always less then 255 CEQ TREMZ,@FAC No spaces after!!! BS LLISZ7 CEQ REMZ,@FAC No spaces after REM BS LLISZ7 CHE COMMAZ,@FAC Master stuff =>space BR LLISZ0 CEQ USINGZ,@FAC Master stuff =>space BS LLISZ0 CEQ NUMBEZ,@FAC "#" never followed by space BR LLISZ1 LLISZ7 CLR @FAC2 Avoid spaces behind here LLISZ1 CLR @FAC3 Indicate separator not needed BR LLIZ12 Continue for next keyword *********************************************************** * Convert a number from binary to ASCII * Input : binary number in ARG2 and ARG3 * Output : pointer to ASCII number in FAC11 with the actual * number lying just before and ending with FAC10. * i.e. the last digit of the ASCII representation * is in FAC10; number of digits in the number in * ARG5 *********************************************************** CVRTLN CLR @ARG5 Start with 0 characters ST ARG11,@ARG11 Select first address + 1 G6F90 DCLR @ARG Clear upper 2 bytes of 4 byte DEC @ARG11 Go to next position DDIV 10,@ARG Compute least significant rem ADD >30,@ARG3 Always < 10 off course ST @ARG3,*ARG11 Store it in ARG DST @ARG,@ARG2 Replace remainder by result INC @ARG5 Update total # of characters DCZ @ARG2 Until whole number converted BR G6F90 LLISZ9 RTN * Output a line number to a device (or screen) OUTLN CALL CVRTLN Convert from binary to ASCII OUTLZ1 ST *ARG11,@CHAT Get the next character CALL DSPCHR Display the character INC @ARG11 Increment the character posit DEC @ARG5 Decrement number of digits BR OUTLZ1 Output digit if not all out RTN * Display number on the screen DISO CALL CVRTLN Convert from binary to ASCII DISPZ1 ST *ARG11,V*VARW Get more significant characte ADD OFFSET,V*VARW Display character on screen DINC @VARW Update screen pointer INC @ARG11 Get next position DEC @ARG5 Update count BR DISPZ1 Add loop until finished RTN * Put out a quote DSPQUO ST QUOTE,@CHAT DISPLAY A QUOTE * Put out next character DSPCHR CH @RECLEN,@CCPPTR Action on end of screen BR G6FDE CALL OUTREC Output crrrent record DSUB 32,@VARW Keep track of begining of lin G6FDE ST @DSRFLG,V*CCPADD Put offset on screen ADD @CHAT,V*CCPADD Add in the character DINC @CCPADD Bump output pointer INC @CCPPTR Update current line positon ST @CHAT,@FAC10 FAC10 may be used by OUTREC ! RTN *********************************************************** * Static scanner to build the main symbol table and to buil * symbol tables for each subprogram and to build the * subprogram table. Checks some errors and aborts if any * detected. *********************************************************** *---------------------------------------------------------- * Added the following 6/8/81 for NOPSCAN feature * Flag PSCFG: >00 NOPSCAN * >FF RESUME PSCAN PRESCN ST >FF,V@PSCFG Default to PSCAN *---------------------------------------------------------- DCLR @CALIST Initialize call list DST 10,@DFLTLM Set default array size DCLR @XFLAG Initialize prescan flag bits * and FOR/NEXT counter CZ @PRGFLG If imperative BR G700B DST CRNBUF,@PGMPTR Pointer to 1st token XML PGMCHR Get the 1st token XML SCROLL Scroll the screen CALL SCAN10 Do the static scan of the lin BR G7013 If program G700B CALL SCAN Scan the program AND >90,@FLAG Reset all the flags but the * TRACE & LIST/EDIT protection DCLR @LSUBP G7013 DST V@SAVEVP,@VSPTR Initialize VSPTR B EXEC Execute the program or statem *********************************************************** * Static Scanner *********************************************************** SCAN DST @ENLN,@EXTRAM 1st address of line # table DADD 3,@EXTRAM DCLR @SYMTAB Clear the symbol table DCLR @SUBTAB Clear the subprogram table CZ @RAMTOP BR G7031 DST @STLN,@FREPTR Initialize free-space pointer DDEC @FREPTR Back up from line # table BR G703B G7031 DST @STLN,@RAMFRE Initialize ERAM free-space DDEC @RAMFRE pointer DST @>8370,@FREPTR Initialize with no pgm in VDP G703B CLR @BASE OPTION BASE = 0 DST @FREPTR,@STRSP Initailize string space DST @STRSP,@STREND DST @STLN,@LINUM DINCT @LINUM Point to last line in program * THE FOLLOWING 20 STATEMENTS CANNOT BE SEPARATED OR THE * ASSEMBLY LANGUAGE CODE WILL NOT WORK - SRH XML SCNSMT Scan the program BYTE 0 * Entire program flag SCAN10 XML SCNSMT Scan the statement BYTE 2 * Single statement flag BR SCANRT Normal end of scan BR SCNDEF Scan a def BR SCNDIM Scan a dim BR CALLS Scan a call BR SCNOPT Scan an option base BR SUBS Scan a sub BR SUBNDS Scan a subexit BR SUBNDS Scan a subend BR CALENT Call ENTER BR ERROLP * ONLY LEGAL IN A PROGRAM BR ERRNWF * NEXT WITHOUT FOR BR ERRFNN * FOR/NEXT NESTING BR ERRMS * MISSING SUBEND BR ERRSYX * SYNTAX ERROR BR ERRMEM * MEMORY FULL BR ERRIBS * ILLEGAL AFTER SUBPROGRAM * * SPECIALLY SCANNED STATEMENTS * DIM STATEMENT SCNDIM CLOG >40,@XFLAG BR ERRSYX G7073 CALL ENTER Declare this symbol CEQ COMMAZ,@CHAT Loop if more BS G7073 BR SCAN25 Must have EOL now * OPTION BASE STATEMENT SCNOPT CALL IMPIF Can't be imperative or in "IF CALL PGMERR OPTION - therefore must be BA CLOG >02,@XFLAG BR ERROBE * Error if OPTFLG already set CALL CHKSYN Must have a "BASE" BYTE BASEZ CALL CHKSYN Must have a numeric constant BYTE NUMCOZ CALL CHKSYN Must have 1-char numeric cons BYTE 1 CLR @BASE Assume BASE=0 SUB >30,@CHAT Must be 0 or 1 BS SCAN20 OK if 0 DEC @CHAT Check for a 1 BR ERROBE If it was not a 1 then ERROR INC @BASE Set OPTION BASE=1 SCAN20 OR >02,@XFLAG Set the option base flag SCAN22 XML PGMCHR Now - check for end-of-line SCAN25 CALL CHKEND If not EOL or :: or ! -err BS CONSCN If EOS - continue scan BR ERRSYX * SYNTAX ERROR * DEF STATEMENT SCNDEF CALL IMPIF Can't be imperative or in "IF OR >84,@XFLAG Set function bit * Set ENTERX bit CALL ENTER Enter the function name * ENTER resets function bit CLOG >07,V*SYMTAB Did function have parm? BS SCAN55 No... OR >80,@XFLAG >80 call for parm enter OR >08,@FLAG Fake it so symbol table * searches won't be made CALL ENTERW Enter the parameter AND >F7,@FLAG Reset function bit CALL CHKSYN Complex symbol must be BYTE RPARZ * followed by ")=" CALL CHKSYN BYTE EQUALZ MOVE 29,V*SYMTAB,V@CRNBUF DST V@CRNBUF+4,@VAR0 Get pointer to name CZ @RAMTOP If ERAM program BS G70EB * If ERAM must fix up the name pointer because the name was * moved too DSUB @SYMTAB,@VAR0 Offset into entry DADD CRNBUF,@VAR0 New location of name DST @VAR0,V@CRNBUF+4 Put it in G70EB DST V@2(@SYMTAB),@FREPTR * Reset free space pointe DST CRNBUF,@SYMTAB Point into crunch buffer DDEC @FREPTR SCAN35 CALL CHKEND If EOL or ! or :: BS SCAN50 Yes CGT >00,@CHAT BS SCAN40 CEQ NUMZ,@CHAT If numeric - skip it BS SCAN45 CEQ STRINZ,@CHAT If string - skip BR G710D SCAN45 CALL SKPSTR Skip the string or numeric G710D XML PGMCHR Get next charater BR SCAN35 * Jump always SCAN40 OR >80,@XFLAG Make an ENTERX (>80)call CALL ENTERX Enter the symbol **** Relink to keep parameter at the beginning of the table DCEQ CRNBUF,@SYMTAB If no entry BS SCAN35 DST V@CRNBUF+2,V@2(@SYMTAB) * Put link in DST @SYMTAB,V@CRNBUF+2 Put new pointer in DST CRNBUF,@SYMTAB Put new pointer in BR SCAN35 Go on * Jump always SCAN50 DST V@CRNBUF+2,@SYMTAB Delink the parameter BR CONSCN Continue the scan SCAN55 CALL CHKSYN BYTE EQUALZ BR CONSCN CALENT OR >80,@XFLAG Set enterx (>80) flag CALL ENTERX Enter in symbol table CONSCN XML SCNSMT Return to 9900 code to resume BYTE 1 * Return call to 9900 code IMPIF CLOG >40,@XFLAG Not in if BR ERRSYX IMPILL CZ @PRGFLG Program mode - OK - return BR SCANRT ERROLP CALL ERRZZ If imperative - error BYTE 27 * Only legal in a program * Syntax required token routine CHKSYN FETCH @FAC CEQ @FAC,@CHAT BS PGMERR ERRSYX CALL ERRZZ BYTE 3 * Syntax error CHKEND CLOG >80,@CHAT BS G7168 CHE TREMZ+1,@CHAT BS G7168 CEQ @>8300,@>8300 Force COND to "SET" RTNC G7168 CZ @CHAT Set COND according to CHAT SCANRT RTNC *********************************************************** * CALLS routine * This routine scans the CALL statement. Get the subprogram * name, search the table and update the call list * (value stack area) if necessary. Share eht same XML * search routine as the symbol table code uses. *********************************************************** CALLS XML PGMCHR Get token after call CALL CHKSYN Check subprogram name BYTE UNQSTZ * Must start with unquoted stri CH >0F,@CHAT * NAME TOO LONG!! BS NTLERR DST @PGMPTR,@VAR0 Save program pointer to name ST FAC,@FAC17 Set up a pointer ST @CHAT,@FAC15 Save name length ST @CHAT,@FAC16 Save name length as a counter CALL20 XML PGMCHR Get one byte of name ST @CHAT,*FAC17 Store that character in FAC a INC @FAC17 Increment pointer DEC @FAC16 Decrement conter BR CALL20 Get next character * Exchange call list address wit * symbol table address to run th * same search routine used for * symbol table search. DEX @SYMTAB,@CALIST XML SCHSYM Search to see if name there DEX @CALIST,@SYMTAB Exchange back both addresses BS SCAN67 If name found do nothing CZ @RAMFLG If not imperative and ERAM BS G71AE XML VPUSH Put first 8 byte of name DST @VSPTR,@VAR0 Pointing to new name location CGT >08,@FAC15 If more characters in name BR G71AE MOVE 8,@FAC8,@FAC Move rest of the name XML VPUSH Push one more time G71AE CLR @FAC ST @FAC15,@FAC1 Put in name length DST @CALIST,@FAC2 Put in call list link DST @VAR0,@FAC4 Put in pointer to name XML VPUSH Put the entry in the VDP DST @VSPTR,@CALIST Change pointer to call list SCAN67 XML PGMCHR BR CONSCN *********************************************************** * SUBS routine * This routine scans SUB statement in subprogram. First * check the subprogram name and call list. Then builds * subprogram table without argument list, scans symbols in * the subprogram and create symbol table for the subprogram * make entry to the subprogram table and add (if necessary) * to call list. *********************************************************** SUBS CALL IMPIF Can't be imperative or in "IF CZ @FORNET Check FOR-NEXT nesting BR ERRFNN CLOG >01,@XFLAG Called first time BR G71D7 CLOG >08,@XFLAG BR ERRMS * Cannot be in subprogram. Can't start another one. DST @SYMTAB,V@TABSAV Finish off main table * From the second SUB statement G71D7 DCLR @SYMTAB Start with empty symbol table OR >28,@XFLAG Set flag for SAFLG and SUBFLG AND >FE,@XFLAG Reset REMODE flag XML PGMCHR Get name behind SUB statement CALL CHKSYN Make sure it's unquoted strin BYTE UNQSTZ CH >0F,@CHAT Length must be <= 15 BS NTLERR ST @CHAT,@FAC1 Save name length DST @PGMPTR,@FAC4 Assume pointer to VDP name CZ @RAMTOP But if ERAM save name in tabl BS G720E CLR @FAC XML MEMCHK FAC already has name length BS ERRMEM * MEMORY FULL DSUB @FAC,@FREPTR Get pointer to put name in DST @FREPTR,@EEE1 Re-do pointer to name DINC @EEE1 Correct for one off DST @FAC,@FFF1 Set for XML GVWITE DST @PGMPTR,@DDD1 Set for XML GVWITE XML GVWITE Move @FFF1 bytes from ERAM at * DDD1 to VDP at EEE1 * * Start building the subprogram table DST @EEE1,@FAC4 Put pointer in VRAM to name G720E DST 14,@FAC Minimum table size for subpro XML MEMCHK Make sure enough room there BS ERRMEM * MEMORY FULL CLR @FAC Prepare for name length ST @CHAT,@FAC1 Get the name length DST @SUBTAB,@FAC2 Save subprogram table address DCLR @FAC6 Mark end of argumant list * @FAC = name length @FAC2 = subprogram table lin * @FAC4 = pointer to name @FAC6 = argument list = 00 * @FAD8 = @PGMPTR @FAC10 = @EXTRAM * @FAC12 = symbol table = 00 DADD @FAC,@PGMPTR Skip the name to look ahead MOVE 4,@PGMPTR,@FAC8 Copy PGMPTR and EXTRAM DCLR @FAC12 Assume subpgm has no symbol t DSUB 14,@FREPTR Reset free pointer DST @FREPTR,@SUBTAB Copy DINC @SUBTAB Set new subtable pointer MOVE 14,@FAC,V*SUBTAB Put the table in!! * Start fixing up subprogram's symbol table DST @SUBTAB,V@SSTEMP Copy address of subtable DADD 6,V@SSTEMP Point to argument list DST V@SSTEMP,V@SSTMP2 Duplicate for later use XML PGMCHR Get next token CALL CHKEND Check if end of statement BS SCAN90 Yes. Get out here quick * Start looking at aruguments. CALL CHKSYN Check for left parenthesis BYTE LPARZ SCAN86 OR >80,@XFLAG Flag for ENTXFL CALL ENTERX Enter next parameter DST 2,@FAC Get room for ptr in sub block XML MEMCHK See if we had space for 2 byt BS ERRMEM * MEMORY FULL DST V@SSTEMP,@FAC Copy current arg list pointer DSUB @SYMTAB,@FAC Find length from table addres * Move symbol table down two byt * to make space for next argueme MINUST EQU -2 MOVE @FAC,V*SYMTAB,V@MINUST(@SYMTAB) DDECT @SUBTAB Adjust the subtable pointer DDECT V@SSTMP2 Adjust to point to first argu DST V@SSTEMP,@VAR0 DST @SYMTAB,V@MINUST(@VAR0) Put pointer in subtab DST @SYMTAB,@FAC Copy symbol table address DDECT @FAC Pointing to real s.t. address SCAN88 DST V@4(@FAC),@FAC2 Copy pointer to symbol table DDEC @FAC2 DCH @SUBTAB,@FAC2 If name moved also BS G7293 DDECT V@4(@FAC) correct for the movement. G7293 DCZ V@2(@FAC) If more symbol there BS G72A4 DDECT V@2(@FAC) Adjust the link address also DST V@2(@FAC),@FAC Point to next s.t. address BR SCAN88 Check for more s.t. adjustmen G72A4 DST V@SSTMP2,@FAC Restore pointer to first argu G72A8 DCEQ V@SSTEMP,@FAC Fix all pointers in argument BS G72B5 DDECT V*FAC Shift address by 2 bytes DINCT @FAC Go to next argument pointer BR G72A8 G72B5 DDECT @SYMTAB Restore s.t. pointer DDECT @FREPTR Restore free pointer * Done with building a subprogram table. CEQ RPARZ,@CHAT Next character not ")" ? BS G72C4 CALL CHKSYN Must be "," BYTE COMMAZ BR SCAN86 Ge get more argument G72C4 XML PGMCHR Finished... CALL CHKEND Check if end of statement BR ERRSYX If not, error SCAN90 AND >DF,@XFLAG Finished scanning sub argumen DADD 6,V@SSTEMP Point to location of pointer * in subtab BR CONSCN Start scanning subprogram *********************************************************** * SUBNDS and SUBXTS * This routine scans SUBEND and SUBEXIT statement *********************************************************** SUBNDS CALL IMPILL Can't be imperative CLOG >08,@XFLAG BS ERRSNS ********* MUST BE IN SUBPROGRAM message above ************* CEQ SUBNDZ,@CHAT BR G72FB Check for end of statement CZ @FORNET Check FOR-NEXT nesting BR ERRFNN CLOG >01,@XFLAG BR ERRSNS CLOG >40,@XFLAG BR ERRSYX DST V@SSTEMP,@VAR0 DST @SYMTAB,V*VAR0 OR >01,@XFLAG G72FB BR SCAN22 Check for end of statement *********************************************************** * ENTER and ENTERX routines * These routines take care of entering a symbol into the * symbol table. If a symbol is encountered which is already * in the table, the usage of the symbol is checked for * consistency. *********************************************************** ENTER CALL PGMERR Get next token - error if EOL ENTERW CGE >00,@CHAT If token - error BR ERRSYX ENTERX ST FAC-1,@FAC15 FOR INDIRECTION IN NAME SAVE DST @PGMPTR,@NMPTR SAVE POINTER TO NAME DDEC @NMPTR CORRECT FOR PGMCHR POST INCRE ******************** Accumulate the name of the symbol ENT01 INC @FAC15 Count the character CH FAC14,@FAC15 BS NTLERR ST @CHAT,*FAC15 Save it XML PGMCHR Get the next one CGT >00,@CHAT If not token or EOL BS ENT01 DST @PGMPTR,@ARG16 Save text pointer to put into DDEC @ARG16 symbol table entry loater CEQ >24,*FAC15 String variable? BR G732D OR >10,@XFLAG Set string flag G732D SUB FAC,@FAC15 Calculate length of name INC @FAC15 + offset of 1 CEQ LPARZ,@CHAT If complex BS ENT22 CLOG >80,@XFLAG If ENTERX BR ENT08 CLOG >04,@XFLAG BS ERRSYX * If not DEF then DIM without subscripted variable *********************************************************** * CODE FOR SIMPLE ENTRY INTO TABLE * This incudes all non-dimensioned variables as well as * phony entries for no-parameter functions. ENT09 is the * entry point for entering one of these phony entries ENT10 * is the code which checks for consistent use of symbols * within the user's program. *********************************************************** ENT08 DDEC @PGMPTR Correct pointer overshoot ENT09 DST @PGMPTR,@CHSAV Save character pointer CLR @STKMIN+1 Zero dimensions for simple ST STKMIN+1,@TOPSTK Save top of stack CLOG >08,@FLAG No search in function BR ENT16 XML SCHSYM Search symbol table BR ENT16 Not found - must enter it DINC @PGMPTR Correct pointer undershoot * Common code used by SIMPLE and COMPLEX * When the symbol appears in the SYMBOL TABLE. It varifies * that the declarations are the same * (# of paremeters/dimensions, string, funciton) ENT10 CLOG >80,@XFLAG Redeclaring BS ERRMUV CLOG >24,@XFLAG If function or sub-arg BR ERRMUV Then redefining variable UDF ST V*FAC,@VAR0 Fetch declaration AND >07,@VAR0 MASK FUNCTION AND STRING BITS CEQ *TOPSTK,@VAR0 Not same # of dim BR ERRMUV AND >6B,@XFLAG Clear FNCFLG, STRFLG and ENTE RTN All OK - Type matches perfect ENT16 MOVE 16,@FAC,@ARG Save name DST 14,@NMLEN Need 14 bytes for a simple va CLOG >14,@XFLAG String or function? BS ENT61 No - allocate & update table BR ENT60 Yes - need 8 bytes for them * Set count to 8 and update *********************************************************** * CODE FOR A COMPLEX ENTER *********************************************************** ENT22 DST @PGMPTR,@CHSAV Save the line pointer ST STKMIN,@STACK Initiaze base of date stack MOVE 16,@FAC,@ARG Save name CLOG >84,@XFLAG ENTERX or inside a DEF ? BR ENT28 Yes, require special scanning ENT24 XML PGMCHR Get next character CALL CHKSYN Must have numeric constant BYTE NUMCOZ CALL CSINT Convert dimension to integer BS ERRBV If got an error on conversion CZ @FAC If not BIG dim BR G73A6 CHE @BASE,@FAC1 Dim < BASE BR ERRBV G73A6 PUSH @FAC1 Push this dimension PUSH @FAC Both bytes CH STKMAX,@STACK If too many dims BS ERRSYX CEQ COMMAZ,@CHAT If comma-more dims BS ENT24 CEQ RPARZ,@CHAT Ok if end on rpar BS ENT40 BR ERRSYX Didn't end on a rpar ******************* Code for a non-DIM statement ENT28 ST 1,@VAR0 Parenthisis level counter * At first level ENT29 CALL PGMERR Get next token - error if EOL CGT >00,@CHAT BR G73CD CLOG >20,@XFLAG Not accepted? BR ERRBA BR ENT29 Get next token G73CD CEQ RPARZ,@CHAT BS ENT34 CLOG >04,@XFLAG BR ERRSYX CEQ COMMAZ,@CHAT BR G73EC CGT >01,@VAR0 If not top-level command BS ENT29 PUSH @DFLTLM+1 PUSH @DFLTLM Push a default limit CGT STKMAX,@STACK NOT too many dim BR ENT29 BR ERRSYX Too many dims - so error * Jump always G73EC CLOG >20,@XFLAG * BAD ARGUMENT BR ERRBA CEQ STRINZ,@CHAT BR G73FB ENT30 CALL SKPSTR BR ENT29 G73FB CEQ NUMCOZ,@CHAT BS ENT30 CEQ LPARZ,@CHAT BR G7407 INC @VAR0 Increase nesting level G7407 BR ENT29 Not anything above. Get next ENT34 DEC @VAR0 Decrease nesting level BR ENT29 Continue scan unless through PUSH @DFLTLM+1 Push final default limit PUSH @DFLTLM *********************************************************** * Calculate number of dims and search symbol table *********************************************************** ENT40 ST @STACK,@VAR0 Compute the # of dims SUB STKMIN,@VAR0 SRL 1,@VAR0 Divide by 2 PUSH @VAR0 Push the number of dims on to ST @STACK,@TOPSTK Save stack top MOVE 16,@ARG,@FAC Get name back XML SCHSYM Search symbol table for it BR ENT44 Not found in table - ENTER it DST @CHSAV,@PGMPTR Restore scan restart at "(" BR ENT10 And check for consistency ENT44 CLOG >24,@XFLAG If function or subprogram BR ENT60 argument then need 8 bytes * Caculate total number of array elements ST @STACK,@TOPSTK Save stack pointer DEC @STACK Skip # of dims POP @FAC Assume base=0 POP @FAC1 DINC @FAC CLR @VARC But correct if base=1 ST @BASE,@VARC+1 Handle 1st dim specially to DSUB @VARC,@FAC Avoid 1 multiply DST @FAC,@NMLEN FAC gets # of elements in arr B ENT53 Merge into loop ENT50 POP @FAC Get next dimension POP @FAC1 DINC @FAC Assume base=0 DSUB @VARC,@FAC But correct if base=1 DST @NMLEN,@ACCUM DMUL @FAC,@ACCUM Accumulate size DCZ @ACCUM Out of memory BR ERRMEM DST @ACCUM+2,@NMLEN ENT53 CEQ STKMIN,@STACK BR ENT50 CLOG >E0,@NMLEN If any of the top 3 bits set BR ERRMEM then * MEMORY FULL DSLL 1,@NMLEN Assume string| memory=elemets CLOG >10,@XFLAG But it numeric BR G7480 DSLL 2,@NMLEN Memory = 4*(2 * # of elements G7480 DADD 6,@NMLEN Need 6 more bytes for header CLR @FAC For double ST *TOPSTK,@FAC1 Get # of dimensions SLL 1,@FAC1 Multiply by 2 DST @FAC,@VARC Save # of elements for later DADD @FAC,@NMLEN Total # of bytes needed CARRY BS ERRMEM BR ENT61 Jump always ENT60 DST 8,@NMLEN Functions & simple strings ne *********************************************************** * Check to see if enough memory in VDP RAM or ERAM * Put symbol name in table if imperatively created or if * excuting an ERAM program. *********************************************************** ENT61 CZ @RAMTOP If not ERAM BR G74A5 CZ @PRGFLG If program mode BR ENT62 G74A5 CZ @ARG15 If 0-length (function) BS ENT62 * Move the name into the symbol table CLR @VAR0 Re-do name and pointer ST @ARG15,@VAR0+1 Get length of name DST @VAR0,@FAC Put length for MEMCHK XML MEMCHK Check enough memory for name BS ERRMEM * MEMORY FULL DSUB @VAR0,@FREPTR Get space for the name DST @FREPTR,@NMPTR Set new pointer to name DINC @NMPTR New pointer to name MOVE @VAR0,@ARG,V*NMPTR Move the name ENT62 CLR @FAC7 Assume not simple numeric CZ @RAMTOP Set simple numeric variable BS ENT63A ST @TOPSTK,@STACK Get # of dimensions of pareme POP @FAC8 CLOG >14,@XFLAG If string or UDFunction BR ENT62A Yes, don't set FAC7 * No, if array? CZ @FAC8 Not array BR ENT62A INC @FAC7 Has to be a simple numeric DST @NMLEN,@VAR0 Check enough memory in VDP DST 8,@NMLEN For later use - to locate DST @NMLEN,@FAC Check enough memory in VDP XML MEMCHK BS ERRMEM * MEMORY FULL BR ENT63 Check enough memory in ERAM ENT62A CLR @FAC6 CLOG >04,@XFLAG BR ENT63A * UDFunction ST @FAC8,@FAC6 CZ @FAC6 String or numeric array? BS ENT63A * If numeric array goto ENT62B. When checking subprogram * arguments, numeric array is treated the same as string * array case. CLOG >20,@XFLAG BR ENT62C CLOG >10,@XFLAG BS ENT62B ENT62C CLR @FAC6 Clear FAC6 to indicate string BR ENT63A So skip the next portion * Numeric array case... ENT62B DST @NMLEN,@VAR0 Store @NMLEN in temporary DST @VARC,@NMLEN # of bytes for dimension info DADD 8,@NMLEN # of bytes need in the symbol * table entry in VDP RAM DST @NMLEN,@FAC Check enough memory in VDP RA XML MEMCHK BS ERRMEM * MEMORY FULL DST @VAR0,@FAC Restore @NMLEN from VAR0 DSUB @VARC,@FAC DSUB 6,@FAC ENT63 DST @RAMFRE,@FAC2 Get ERAM free pointer DSUB @FAC,@FAC2 Calculate lowest address need DINC @FAC2 One byte off here DCHE CPUBAS,@FAC2 * MEMORY FULL BR ERRMEM DST @FAC2,@RAMFRE Set new ERAM freespace pointe BR ENT65 ENT63A DST @NMLEN,@FAC No, # of bytes needed XML MEMCHK * MEMORY FULL BS ERRMEM in VDP RAM * Now, construct the entry for the symbol table in the FAC * for ease and speed. Then move it to VDP RAM ENT65 CLR @FAC Clear the header byte CLOG >10,@XFLAG If string BS G7548 OR >80,@FAC Set string bit in header G7548 CLOG >04,@XFLAG If UDFunction BS G7550 OR >40,@FAC Set function bit G7550 ST @TOPSTK,@STACK Get # of dimensions or parame POP @FAC8 CZ @FAC8 If array or parameters BS ENT67 OR @FAC8,@FAC Overlay # of dimensions CLOG >24,@XFLAG If def or sub-arg BR ENT67 Don't set opt flag OR >02,@XFLAG Array so set OPTION BASE flag ENT67 ST @ARG15,@FAC1 Save length of name DST @SYMTAB,@FAC2 Link to previous entry DST @NMPTR,@FAC4 Save pointer to the name DSUB @NMLEN,@FREPTR Set new table pointer DINC @FREPTR * Move the entry from the FAC to the symbol table MOVE 6,@FAC,V*FREPTR DST @FREPTR,@SYMTAB Pointer to beginning of table CLOG >08,@FLAG If not run-function modify BR G758B CLOG >08,@XFLAG If not in subprogram BR G758B DST @SYMTAB,V@SYMBOL Save pointer in VDP RAM G758B DADD 6,@FREPTR CZ @RAMTOP If ERAM exists then BS G75C1 CEQ >01,@FAC7 If simple numeric variable BR G75A8 DST @VAR0,@NMLEN Restore NMLEN DST @RAMFRE,V*FREPTR Set the pointer into ERAM CLOG >20,@XFLAG BR ENT69 BR G75BF G75A8 CLOG >20,@XFLAG BR ENT69 CZ @FAC6 If numeric array BS G75BF DST @VAR0,@NMLEN Restore NMLEN DST @VARC,@VAR0 Leave the space for dimension * info whtich is going to be * filled in later DADD @FREPTR,@VAR0 DST @RAMFRE,V*VAR0 Set pointer in ERAM G75BF BR G75C6 G75C1 CLOG >20,@XFLAG BR ENT69 G75C6 CLOG >04,@XFLAG If UDF - no dimensions BS G75D1 DST @ARG16,V*FREPTR SAVE POINTER TO "(" OR "=" BR ENT69B Jump always **** Save the dimension information in the symbol table G75D1 CGT STKMIN,@STACK If non-array BR ENT69 ST STKMIN,@STACK Get to bottom of stack ENT68 INC @STACK Point tat LSB of next entry CHE @TOPSTK,@STACK If finished, out BS ENT69 ST *STACK,V@>01(@FREPTR) * Put directly into tabl INC @STACK Point at MSB of next entry ST *STACK,V*FREPTR Put directly into table DDECT @NMLEN Used up 2 bytes in table DINCT @FREPTR Adjust pointer to unused byte BR ENT68 Get next dimension ***** Now, zero the required amount of memory ENT69 CZ @RAMTOP If ERAM exists BS ENT69D CLOG >10,@XFLAG BR ENT69D CEQ >01,@FAC7 If simple numeric variable BR G7608 DST 8,@NMLEN Zero 8 bytes of ERAM memory BR ENT69C G7608 CZ @FAC6 If numeric array BS G7618 DSUB 6,@NMLEN Calculate amount of ERAM to c ENT69C XML IO Special code to clear ERAM BYTE 3 * Select the clear - ERAM code BYTE RAMFRE * Address of ERAM address BYTE NMLEN * Address of number of bytes DDEC @RAMFRE Adjust ERAM free pointer G7618 BR ENT69B VDP case ENT69D DSUB 7,@NMLEN Now clear VDP RAM CLR V*FREPTR Clear 1st byte, then the rest MOVE @NMLEN,V*FREPTR,V@1(@FREPTR) ENT69B DST @SYMTAB,@FREPTR Set new free pointer @ then t DDEC @FREPTR Now, set it at 1st free byte AND >EB,@XFLAG Clear STRFLG and FNCFLG CLOG >80,@XFLAG If ENTERX call BS G763D CLOG >20,@XFLAG If not scanning BR G763D a subprogram argument then DST @CHSAV,@PGMPTR Restore character pointer G763D XML PGMCHR Get next character RTN *********************************************************** * THIS ROUTINE READS A CHARACTER AND WILL GIVE AN ERROR IF * IT READS AN END OF LINE (PREMATURE END) *********************************************************** PGMERR XML PGMCHR CALL CHKEND BS ERRSYX Premature EOL RTN *********************************************************** * THIS ROUTINE SKIPS QUOTED STRINGS UNQUOTED STRINGS AND * NUMERIC CONSTANTS *********************************************************** SKPSTR XML PGMCHR Get the byte count CLR @VARC for double ST @CHAT,@VARC+1 Get count for add DADD @VARC,@PGMPTR Skip the string RTN * ERROR messages called in this file ERRIBS CALL ERRZZ * ILLEGAL AFTER SUBPROGRAM BYTE 4 NTLERR CALL ERRZZ * NAME TOO LONG BYTE 6 ERROBE CALL ERRZZ * OPTION BASE ERROR BYTE 8 ERRMUV CALL ERRZZ * IMPROPERLY USED NAME BYTE 9 ERRMEM CALL ERRZZ * MEMORY FULL BYTE 11 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 ERRMS CALL ERRZZ * MISSING SUBEND BYTE 17 ERRBA CALL ERRZZ * BAD ARGUMENT BYTE 28 ERRBV CALL ERRZZ * BAD VALUE BYTE 30 * Other error messages inside this program * ERRSYN * SYNTAX ERROR DATA 3 * ERROLP * ONLY LEGAL IN A PROGRAM DATA 27 * ERRPV * PROTECTION VIOLATION DATA 39 *********************************************************** * Search and clean up stack and symbol table to not allow * garbage to accumulate *********************************************************** CLEAN DST @VSPTR,@FAC8 Get a temporary stack pointer CLEAN1 DCH @STVSPT,@FAC8 While not end of stack BR G76BE ST V@2(@FAC8),@FAC14 Get stack ID byte SUB >66,@FAC14 Check the range CH >04,@FAC14 If string, numeric, >70, >72 BR G7698 XML VPOP Throw it away (Must be on top BR CLEAN G7698 CASE @FAC14 BR CLEANG GOSUB entry >6 BR CLEANF FOR entry >6 BR CLEANU UDF entry >6 BR CLEANE ERROR entry >6 BR CLEANS SUB entry >6 CLEANE CALL SQUISH ERROR Entry - squish it out CLEANG DSUB 8,@FAC8 Go down 1 entry BR CLEAN1 Go on to next entry * Jump always CLEANF DSUB 16,@FAC8 Keep it around but get below CLEANS DSUB 16,@FAC8 16 bytes further down BR CLEAN1 FOR or SUB entry * Jump always CLEANU DCLR @FAC4 Cause delink to work right CALL DELINK Delink the symbol table entry BR CLEANG G76BE RTN *********************************************************** * Subroutine to convert numeric to integer *********************************************************** CSINT DCLR @FAC Start with clean FAC CSINT2 XML PGMCHR SUB >30,@CHAT Subtract ASCII value for "0" CHE >0A,@CHAT Valid numeric BS G76E3 DMUL 10,@FAC Multiply previous result DCZ @FAC Overflow ?????? BR RETSET ST @CHAT,@FAC1 Get result back down DADD @FAC2,@FAC Add current digit CARRY If >65535 BS RETSET CGE >00,@FAC Integer > 32767 BR RETSET BR CSINT2 And loop until done G76E3 ADD >30,@CHAT RTN Also used somewhere else RETSET CEQ @>8300,@>8300 RTNC * * GKXB CODE FOLLOWS *************************************** RES1 DCLR @PGMPTR Set flag DST @STLN,@XSTLN Save STLN & ENLN DST @ENLN,@XENLN CALL AUTON Get first parameters INC @PGMPTR Destroy flag RTN * * RES2 entered from AUTON if more than 2 numbers entered * RES2 DCZ @PGMPTR Check flag BS RES2A Yes, continue B CKOTHR No, check for copy & move RES2A INC @PGMPTR Destroy flag CEQ COMMA,@CHAT Check for comma BR ERRSY1 If no comma DST @CURLIN,@XCURLI Save CURLIN & CURINC DST @CURINC,@XCURIN DCLR @CURLIN Clear out pointers DCLR @CURINC ST DASH,@VARC Separator CALL AUTO3 Get range CALL GTRANG Find locations in line table DST @XCURLI,@CURLIN Restore CURLIN & CURINC DST @XCURIN,@CURINC DCEQ @XENLN,@ENLN See if start line is first line BS RES3 Yes, continue DST @XENLN,@FAC Copy start addr to FAC DINC @FAC Point to next lower table entry CALL GRSUB3 Get line # of line before start BYTE FAC-PAD DCH @EEE1,@CURLIN New start # must be higher than * last # in preceding segment BR ERRBLN Bad line number if not! RES3 RTN * RES4 DST @ENLN,@PGMPTR Moved from RES routine CZ V@CRNBUF Called from RES? BS RES4B No, skip a few lines DCEQ @XSTLN,@STLN Renumbering to end of prog? BS RES4A Yes, skip the check DST @XSTLN,@FAC Check for high # overlap DSUB 4,@FAC Point to entry after RES segment CALL GRSUB3 Get that line # BYTE FAC-PAD RES4B DCHE @EEE1,@CURLIN Check that CURLIN is'nt higher * or equal BS ERRBLN If so, bad line number RES4A RTN * RES5 CEQ 6,V@CRNBUF A true RES? BS TOPL25 Yes, return to basic RTN No, just do a return * * Code for new commands DEL, COPY, and MOVE * * NOTICE !!!!! * RAM BANK 2 CHANGED AS FOLLOWS----- * 7D1B changed from >08 to >0B * 7D35 changed from >08 to >0C * * NEWCMD CH >0B,V@CRNBUF If higher than MOVE token, BS SZRUN4 continue with old stuff DST CRNBUF+1,@PGMPTR Anticipate usage of PGMCHR XML PGMCHR Setup CHAT ST V@CRNBUF,@FAC Copy token SUB 9,@FAC Adjust for CASE CASE @FAC Select the keyword BR DEL BR COPY BR MOVE * * Patch to change to default colors on RUN * RUNPAT CZ @PRGFLG Program already running? BR RUNRET Yes, do nothing BACK 7 Screen color ST >10,V@>80F Character colors MOVE 16,V@>80F,V@>810 RUNRET CLR @PRGFLG Moved from RUN routine B G6504 Return * * DEL routine... Allows the deletion of a program segment * DEL ST DASH,@VARC Select separator DCLR @CURLIN Clear variables DCLR @CURINC CALL AUTO1 Get parameters DST @STLN,@XSTLN Save pointers DST @ENLN,@XENLN CALL GTRANG Get the range to delete * DEL01 DST @ENLN,@XCURLI Store a copy of ENLN * DST @XENLN,@FAC Check to see if we need DSUB 3,@FAC to delete another line DCHE @XSTLN,@FAC BR DELEND We're through * CALL GRSUB3 Get line # of line to delete BYTE FAC-PAD DST @EEE1,@FAC Store number in FAC ST 1,@CHAT Flag to delete line CALL EDITLN Delete the line * DADD 4,@XSTLN Adjust for deleted line DST @ENLN,@FAC New ENLN value DSUB @XCURLI,@FAC How much did we delete? DADD @FAC,@XSTLN New XSTLN value DADD @FAC,@XENLN New XENLN value B DEL01 Loop DELEND B TOPL20 Return to basic * GTRANG - Sets XSTLN & XENLN as a line # * table for a range of line #s in CURLIN * & CURINC. XSTLN & XENLN should contain * the values in STLN & ENLN when called. * A bad line number error is generated if * the range does not contain at least one * valid program line. If CURINC is zero, * then the line # in CURLIN must be a valid * program line. A syntax error is occurs if * both CURLIN & CURINC are zero. * GTRANG DCEQ @STLN,@ENLN If no program, then error BS ERRNPP DST @ENLN,@FAC Get first line # DSUB 3,@FAC FAC=source addr in ERAM/VDP DCZ @CURLIN Beginning line specified? BR GTRAN0 Yes, get it DCZ @CURINC Ending line also zero? BS ERRSY Yes, syntax error GTRAN0 CALL GRSUB3 Read the line # BYTE FAC-PAD DCHE @CURLIN,@EEE1 Check for good number BS GTRAN2 Good number DSUB 4,@FAC Get next table entry DCHE @STLN,@FAC Make sure we're still in table BS GTRAN0 Loop till good number found BR ERRBL Bad line number error GTRAN2 DST @FAC,@XENLN Store for RES routine DADD 3,@XENLN Fake an ENLN entry * Evaluate what's in CURINC GTRAN1 DCZ @CURINC Zero? BR GTRAN4 No, go get a line # DST @VARW,@FAC2 Store screen pointer GTRAN3 DDEC @FAC2 Back up one space on screen CEQ OSPACE,V*FAC2 Is it a space? BS GTRAN3 Yes, loop till no space CEQ DASH+OFFSET,V*FAC2 Is it a dash? BS GTRAN7 Yes, use default for STLN BR GTRAN8 Just one # entered, check it! GTRAN4 DCH @CURINC,@CURLIN End line higher than start? BR GTRAN5 No, go get end line DST @CURLIN,@CURINC Make a good line # GTRAN5 CALL GRSUB3 Get next line # BYTE FAC-PAD DCH @CURINC,@EEE1 Gone too far? BS GTRAN6 Yes, we're done DSUB 4,@FAC Next table entry DCHE @STLN,@FAC Make sure we're still in table BS GTRAN5 Loop BR GTRAN7 End of table, use default GTRAN6 DADD 4,@FAC Back up one entry GTRAN9 DST @FAC,@XSTLN Put it in place GTRAN7 DCH @XENLN,@XSTLN If XSTLN > XENLN then error BS ERRBL RTN GTRAN8 CH 9,V@CRNBUF Called from RES or DEL? BS GTRAN9 No, skip this check DCEQ @EEE1,@CURLIN Check that line found is good BR ERRBL Bad line number if not BR GTRAN9 Set XSTLN and return * ERRSY B ERRSY1 ERRBL B ERRBLN ERRNPP B >64EF No program present * * CKOTHR - Intercepts error from AUTON if more than * two line #s are entered. * CKOTHR CH >B,V@CRNBUF Error if higher than MOVE BS ERRSY CH >9,V@CRNBUF Error if lower than COPY BR ERRSY CEQ COMMA,@CHAT Check separator BR ERRSY Error if not RTN Return if OK * * GETPAR - gets a line # range and a new starting * # and increment for MOVE & COPY * GETPAR DST @ENLN,@XENLN Load segment pointers DST @STLN,@XSTLN DCLR @CURLIN Set up variables DCLR @CURINC ST DASH,@VARC Separator CALL AUTO1 Get segment start, end CALL GTRANG Get line table range DCZ @CURINC Fix XSTLN if necessary BR GETPA3 DST @STLN,@XSTLN * Now get new starting # and increment GETPA3 DCLR @CURLIN Clear start line# DINC @VARW So AUTON don't screw up CLR V@CRNBUF So AUTON checks EOS correctly CALL AUTO4 Get numbers DCZ @CURLIN Must specify starting line # BS ERRSY Syntax error if not * Find out where to move/copy the segment DST @ENLN,@FAC End of table to FAC DSUB 3,@FAC Adjust GETPA1 CALL GRSUB3 Get line # from table BYTE FAC-PAD DCHE @CURLIN,@EEE1 If high, segment gets moved here BS GETPA2 Go move it! DSUB 4,@FAC Next table entry DCHE @STLN,@FAC Make sure we're still in table BS GETPA1 Search some more DST >8000,@EEE1 To satisfy RES routine CEQ @FAC,@FAC Set COND bit RTNC Return w/COND GETPA2 RTN Return * * MOVE -Moves a program segment within a program * If the new starting line is within the segment to * be moved, then the segment is just renumbered. * MOVE CALL GETPAR Get the parameters BS MOVE09 Segment goes to end of program * Check to see if new start line is inside moved segment DCH @XENLN,@FAC If FAC is higher than segment end BS MOVE03 then continue DCH @FAC,@XSTLN If FAC is lower than segment start BS MOVE03 then continue * Segment need not be moved, just RES INC V@CRNBUF Fake a RES, almost CALL RES6 Do the RES BR MOVE99 Return * If new start line is a valid program line outside of * segment to be moved, then error! MOVE03 DCEQ @EEE1,@CURLIN Check for equal #s BS ERRBL Bad line number error * New location found. MOVE09 DST @FAC,@XCURLI Save FAC DADD 3,@XCURLI Adjust to end of pointer DST @XENLN,@VARA Find out how many bytes to move DSUB @XSTLN,@VARA DINC @VARA CALL MEMFLL See if there's enough memory DADD @VARA,@STLN Correct STLN CALL RES6 RES the segment CALL CLSALL Close all open files CALL KILSYM Kill the symbol tables * Now redo the line number table * First make space for moved segment DCH @XCURLI,@STLN If moving to end of prog BS MOVE05 then skip this part DST @XCURLI,@ARG Figure byte count DSUB @STLN,@ARG DINC @ARG DST @STLN,@VAR9 Source address DST @STLN,@VAR0 Figure destination addr DSUB @VARA,@VAR0 CZ @RAMTOP If pgm in VDP BR MOVE04 MOVE @ARG,V*VAR9,V*VAR0 Move it! BR MOVE05 MOVE04 XML MVUP If pgm in ERAM * Space now available to move the segment * Figure whether up or down move MOVE05 DST @VARA,@ARG Byte count for next move DCH @XCURLI,@XSTLN BS MOVE06 Moving to a higher line # * Move from a higher # to a lower # DST @XSTLN,@VAR0 DDEC @VAR0 Source address DST @XCURLI,@VARY2 Destination address XML MVDN Move it DST @XSTLN,@ARG Figure byte count DSUB @STLN,@ARG DCZ @ARG Don't move zero bytes BS MOVE99 DST @XSTLN,@VARY2 Figure destination address DDEC @VARY2 DST @VARY2,@VAR0 Figure source address DSUB @VARA,@VAR0 XML MVDN Move again MOVE99 CALL CLSALL B TOPL10 Return to basic * Move from a lower # to a higher # MOVE06 DST @XSTLN,@VAR9 Source address DST @XCURLI,@VAR0 Figure destination address DSUB @VARA,@VAR0 DINC @VAR0 CZ @RAMTOP If pmg in VDP BR MOVE07 MOVE @ARG,V*VAR9,V*VAR0 Move it! BR MOVE08 MOVE07 XML MVUP If pgm in ERAM MOVE08 DST @XENLN,@ARG Figure byte count DSUB @STLN,@ARG DINC @ARG DST @XSTLN,@VAR0 Figure source address DDEC @VAR0 DST @XENLN,@VARY2 Destination address XML MVDN Move again BR MOVE99 Return * * COPY - copies a block of program lines to any * other location in the program * COPY CALL GETPAR Get the parameters DCEQ @EEE1,@CURLIN Error if trying to copy BS ERRBL to a valid line. DST 4,@XCURLI Set a variable DST @EEE1,@XCURIN Save EEE1 * Check to see if new start line is inside copied segment DCH @XENLN,@FAC If FAC is higher than segment end BS COPY03 then continue DCH @FAC,@XSTLN If FAC is lower than segment start BS COPY04 then continue DADD 3,@FAC One last chance DCEQ @FAC,@XENLN Make sure we're going lower BS COPY03 COPY05 BR ERRBL Error if we get here COPY03 DSUB 4,@XCURLI New variable COPY04 DST @XENLN,@FAC Compute # of increments required DSUB @XSTLN,@FAC # of table entries DSRL 2,@FAC # of lines DST @FAC,@XENLN Save count DINC @XENLN Adjust DMUL @CURINC,@FAC Compute space taken by increment DCZ @FAC Check overflow BR ERRBL Error if > 65536 DADD @FAC2,@CURLIN Compute highest line # CARR Test carry bit BS ERRBL Error if > 65536 CH >7F,@CURLIN Error if > 32767 BS ERRBL DCHE @XCURIN,@CURLIN Error if last line overlaps BS ERRBL * Do the actual COPY DINCT @XSTLN Point to line location COPY00 CALL GRSUB2 Get the location BYTE XSTLN-PAD DST @EEE1,@FAC Copy EEE1 DDEC @FAC Point to length byte CALL GRSUB2 Get the length byte BYTE FAC-PAD ST @EEE1,@CHAT Store the length in CHAT ST @EEE1,@FFF1+1 Also use for count CLR @FFF1 Assure correct count DINC @FAC FAC points to program text CZ @RAMTOP If zero, then pgm in VDP BS COPY01 * If program in ERAM DST @FAC,@DDD1 Source address DST CRNBUF,@EEE1 Destination address XML GVWITE Move to VDP BR COPY02 * If program in VDP COPY01 MOVE @FFF1,V*FAC,V@CRNBUF Move into CRNBUF * COPY02 DST @CURLIN,@FAC Line # to FAC CALL EDITLN Edit the line into program CLR @FAC Find next line in table ST @CHAT,@FAC1 DINC @FAC DSUB @FAC,@XSTLN DADD @XCURLI,@XSTLN DSUB @CURINC,@CURLIN Next new line # * DDEC @XENLN Count -1 BR COPY00 Loop if not done B TOPL20 Return * * Code to pick up line # range and record * length for LIST routine * GTLIST CLR @XSTLN Clear for record length CLR @VARC Force an error, maybe CALL AUTO1 Get a number * If we get here, only one number has * been entered so just return RTN * CKLIST CZ @VARC Limit check to LIST BR ERRSY CEQ COLON,@CHAT Record length BR CKLI01 No DDEC @PGMPTR Back up to last CHAT XML PGMCHR Get it CZ @CHAT File specified? BS ERRSY No, error out DCH >FF,@CURLIN Number OK? BS ERRBL No, indicate an error ST @CURLIN+1,@XSTLN Everything OK DCLR @CURLIN Set up to get range ST DASH,@VARC B AUTO3 Get range and return CKLI01 CEQ DASH,@CHAT Better be a dash! BR ERRSY Nope B AUTO5 Finish up *********************************************************** CTRLS CEQ 147,@RKEY CTRL S BR CTRLD No, check more DST @VARW,@ARG5 Force cursor to start * ARG5 = current position BR RBACK Now process like FCTN S CTRLD CEQ 132,@RKEY CTRL D BR CTRLE No, check more DST @VARA,@ARG5 Force cursor to end CALL SPACES Look for space BR RFORW Process like FCTN D CTRLE CEQ 133,@RKEY CTRL E BR CTRLX No, check more DSUB 32,@ARG5 Up one line DCH @ARG5,@VARW Check range BR READZ1 Ok, go on DADD 32,@ARG5 No, redo BR READZ1 And continue CTRLX CEQ 152,@RKEY CTRL X BR CTRL Resume where left off DADD 32,@ARG5 Next line DCHE @ARG5,@VARA Check range BS READZ1 Ok, continue DSUB 32,@ARG5 No, redo BR READZ1 Now, go on CTRL CHE >20,@RKEY Control character!!!! BS G6BD0 BR G6ADC SPACES CEQ >80,V*ARG5 SPACE? BR SPACE2 DDEC @ARG5 BR SPACES SPACE2 CEQ >7F,V*ARG5 CURSOR? BS SPACE3 RTN SPACE3 DSUB 4,@ARG5 BR SPACES BR G6A86 ************************************ MYRUN OR >10,@>83C2 QUIT KEY DST @YPT,@VARY Save Row/Col values BACK >01 ALL >80 FMT SCRO >60 ROW 0 COL 8 HTEX 'FIRMWARE CONTROL' ROW 1 COL 0 HCHA 32,95 ROW 4 COL 6 ******************* HCHA 19,42 * version = 2001 * ROW 4 ******************* COL 6 * R X B * VCHA 8,42 * * ROW 4 * creator * COL 24 * * VCHA 8,42 * RICH GILBERTSON * ROW 5 ******************* COL 8 HTEX 'version = 2011' ROW 6 COL 6 HCHAR 19,42 ROW 7 COL 13 HTEX 'R X B' ROW 9 COL 12 HTEX 'creator' ROW 11 COL 8 HTEX 'RICH GILBERTSON' ROW 12 COL 6 HCHA 19,42 FEND CEQ '1',V@LODFLG BS SCNKEY CZ V@LODFLG BS SCNKEY CEQ >3A,V@LODFLG BS TOPLEV SCAN CEQ >FF,@RKEY BR LDKEY ST V@LODFLG,V@>0824 BR SRCHLP SCNKEY FMT SCRO >60 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 DCEQ >994A,V@>2254 BS XBRUN DST >0800,@FAC+14 DELAY VALUE RSCAN DST >0F12,@YPT CALL CBKEY BS RSCAN2 DDEC @FAC+14 BS SRCHLP BR RSCAN RSCAN2 CEQ >0D,@RKEY ENTER? BS UTIL1 CEQ >2C,@RKEY COMMA? BS BATCH CEQ >2E,@RKEY PERIOD? BS UTIL4 LDKEY CLR V@LODFLG ST @RKEY,V@>0824 SRCHLP MOVE 351,V@>019F,V@>01A0 DCLR V@>2254 Clear flag ST V@>0824,@RKEY FMT SCRO >60 ROW 20 COL 9 HTEX 'Searching ....' ROW 22 FEND CLR @VAR0 Row=0 ST V@>0820,@FAC Get string length CHE 32,@FAC Higher 32? BS STLFSC Yes ST 32,@VAR0 Row=32 SUB @FAC,@VAR0 32-String length SRL 1,@VAR0 Divide by 2 STLFSC ST @VAR0,@XPT Load Column DST >0821,@FAC2 String address DLOOP ST V*FAC2,@VAR0 Character ADD >60,@VAR0 Offset FMT BYTE >E0 BYTE >00 FEND DINC @FAC2 Address+1 DEC @FAC Count-1 BR DLOOP DST @VARY,@YPT Restore YPT/XPT B SZRUNL XBRUN MOVE 50,V@>2256,V@>0820 CLR V@LODFLG BR SRCHLP *********************************************************** UTIL1 CLR V@>2256 FMT COL 0 ROW 15 HCHA 32,32 FEND CLR @FAC DST >0800,@FAC+14 ST >35,@CHAT UTIL2 DST >1112,@YPT CALL CBKEY BS UTIL3 DDEC @FAC+14 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 UTIL4 MOVE 12,G@EAU1,V@>2256 ST @RKEY,V@>225A UTIL5 B GE025 UTIL6 CLR @CHAT BR UTIL5 ********************************* BATCH MOVE 128,V@>01E0,V@>01E1 DST >0800,@FAC+14 LOAD DELAY CLR @FAC BATCH1 DST >1312,@YPT ROW/COL CALL CBKEY BS BATCH2 DDEC @FAC+14 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@>08C0 MOVE 80,V@>08C0,V@>08C1 MOVE 20,G@UBATCH,V@>08C0 ST @RKEY,V@>08CD CLR V@LODFLG BR SZNEW ********************************* CBKEY CLOG >01,@FAC+15 BR CBKEY2 EX @>837D,@FAC SCAN CBKEY2 RTNC ********************************* * RXB USER * DUSER DCEQ >0900,V@>08C2 PAB there? BR NOUSER No CEQ >02,V@>08C0 READ code? BS RUSER READ file CALL UDSR OPEN BYTE >00 BS USEERR ST V@>08C1,@>8356 SRL 5,@>8356 CZ @>8356 BR USEERR DST NLNADD,@VARW Reset screen address READLP DCLR V@>0956 Clear counter CALL UDSR READ BYTE >02 BS CUSER ST V@>08C1,@>8356 SRL 5,@>8356 CZ @>8356 BR CUSER RUSER DST V@>0956,@>8376 Get counter CEQ @>8377,V@>08C5 Counter= # bytes BS READLP yes MOVE 1,V@>0900(@>8376),@RKEY DINC V@>0956 Counter+1 BR USERTN done UDSR MOVE 30,@FAC,V@>03C0 Save FAC FETCH @>8356 Get opcode ST @>8356,V@>08C0 ST >14,V@>08C1 File type DST >08C9,@>8356 CALL LINK BYTE >08 MOVE 30,V@>03C0,@FAC Restore FAC RTNC CUSER CALL UDSR CLOSE BYTE >01 CALL CLRUSR Clear USER PAB NOUSER SCAN RAND 99 RTNC CLRUSR CLR V@>08C0 MOVE 80,V@>08C0,V@>08C1 RTN USEERR CALL CLRUSR MOVE 14,G@ERRUSE,V@>02E2 XML SCROLL ST >0D,@RKEY CALL TONE2 USERTN CEQ @VAR0,@VAR0 RTNC *********************************************************** CHARS EQU >9CEA * GROM ADDRESS FOR CHAR TABLE CHRTBL DST CHARS,@FAC4 DST >400,@FAC CHRLP DCLR V*FAC MOVE 7,G@0(@FAC4),V@1(@FAC) DADD >0008,@FAC DADD >0007,@FAC4 DEC @FAC2 BR CHRLP RTN *********************************************************** * EDITOR ASSEMBLER EAU1 STRI 'DSK1.UTIL1' BYTE >0D * USER PAB & BATCH FILE UBATCH BYTE 0,>14,9,0,80,0,0,0,0 STRI 'DSK1.BATCH' * USER ERROR * ERRUSE BYTE 138,128,181,179,165,178,128 BYTE 165,178,178,175,178,128,128 *************************************** * RXB SEARCH DISK MYSRCH CZ V@LODFLG BR NXTDSK AND >F7,@FLAG B G63E0 NXTDSK INC V@LODFLG BR SZNEW ************************** * RXB TURN SEARCH OFF SCHOFF CLR V@LODFLG B G6A70 ************************************** * MESSAG 'Bytes of Assembly' MESSAG DATA >A2D9,>D4C5,>D380,>CFC6 DATA >80A1,>D3D3,>C5CD,>C2CC BYTE >D9 * AMSMSG 'K AMS ' AMSK DATA >AB80,>A1AD,>B380 * AMSMSG 'BANKS of 4K Pages ' AMSP DATA >A2A1,>AEAB,>B380,>CFC6 DATA >8094,>AB80,>B0C1,>C7C5 DATA >D380 *********************************************************** * CART MOVE 32,G@CPUPGM,@>8300 * Put assembly into fast R ST >FF,@FAC * Byte to load and check for XML >F0 * Execute assembly. CZ @FAC * Is this a RXB Cartridge? BS SZEXIT * No, exit to reset. CART RTN * Yes, continue on. *********************************************************** * * CPU PROGRAM FOR >8300 FAST RAM SUBROUTINE FO CPUPGM DATA >8302 * CPUPGM DATA >8302 * First addr DATA >D820 * MOVB @>834A,@>6FFF * Turn on ba DATA >834A * DATA >6FFF * DATA >9820 * CB @>834A,@>6FFF * Is it a ca DATA >834A * DATA >6FFF * DATA >1302 * JEQ CARTOK * Yes. DATA >04E0 * CLR @>834A * No. DATA >834A * DATA >D820 * CARTOK MOVB @>834A,@>6000 * Turn on ba DATA >834A * DATA >6000 * DATA >04E0 * CLR @>837C * Clear for DATA >837C * DATA >045B * RT * Return to *********************************************************** * AMS SIZE AMSSIZ DCLR @FAC * ISR ADDRESS BUFFER ISROFF EQU >D0FE CALL ISROFF * >D0FE AMSON EQU >D0FA CALL AMSON * >D0FA ST @>5FFE,@FAC12 * SAVE >F000 mapper CEQ >0F,@FAC12 * Initialized BR NOAMS * Not Initalized, end SIZE. DST 512,@FAC8 * PAGE# ST @>401E,@FAC10 * SAVE PAGE # NXTPG DST @>FFFE,@>8300 * Save bytes ST @FAC10,@>401E * Pass mode page DST >AAAA,@>FFFE * Test bytes DCEQ >AAAA,@>FFFE * Test for bytes BR NOAMS * No memory DST @>8300,@>FFFE * Restore bytes DSRL 1,@FAC8 * PAGE # * 2 DCEQ 32,@FAC8 * Largest page # BS SHOWIT * Just show it DEC @FAC9 * PAGE # -1 ST @FAC9,@>401E * >F000 mapper INC @FAC9 * PAGE # +1 DST @>FFFE,@>8300 * Save bytes DST >9999,@>FFFE * Test bytes DCEQ >9999,@>FFFE * Test for bytes BR NXTPG * Continue loop SHOWIT DST >8300,@>FFFE * Restore bytes ST @FAC10,@>401E * Restore PAGE NOAMS DCZ @FAC * ISR? BS NOISR * No ISRON EQU >D0FC CALL ISRON * >D0FC AMSOFF EQU >D0F8 NOISR CALL AMSOFF * >D0F8 CEQ >0F,@FAC12 BR NOAMS2 DSLL 2,@FAC8 * PAGES * 2 = K DST @FAC8,@ARG2 * SHOW K CALL SDISO MOVE 6,G@AMSK,V@1(@VARW) XML SCROLL DSRL 2,@FAC8 * PAGE /4 SUB 17,@FAC9 * PAGES-OS DST @FAC8,@ARG2 * SHOW PAGES CALL SDISO MOVE 18,G@AMSP,V@1(@VARW) NOAMS2 BR G6621 *********************************************************** END Spoiler *********************************************************** TITL 'MYXB4' GROM >8000 *********************************************************** TITL 'EQUATES FLMGR-359' *********************************************************** CPUBAS EQU >A040 Expansion RAM base *********************************************************** * GROM ADDRESSES MZMSG EQU >6038 Start of message area *********************************************************** GTLIST EQU >7A06 GKXB address KEYTAB EQU >CB00 ERRTAB EQU >CD77 TRACBK EQU >CE1F RETNOS EQU >CF68 EDTZZ0 EQU >76EB Edit a line or display it tab EDTZ00 EQU >76F7 Edit a line or display it SAVLIN EQU >7795 Save input line address *********************************************************** * EQUATES FOR ROUTINES FROM OTHER GROM SECTIONS TOPL15 EQU >6012 RETURN FROM OLD or SAVE INITPG EQU >6014 Initialize program space TOPL10 EQU >601A Return to main and re-init KILSYM EQU >6022 KILL SYMBOL TABLE ROUTINE AUTO1 EQU >602E Get arguments for LIST comman TOPL02 EQU >6030 RTN address for failing AUTOL EDITLN EQU >6032 Edit a line into the program GWSUB EQU >6036 Write a few bytes of data to MSGTA EQU >6053 Message "try again" LLIST EQU >6A74 List a line READLN EQU >6A76 Read a line from keyboard WARNZZ EQU >6A82 WARNING MESSAGE ROUTINE ERRZZ EQU >6A84 ERROR MESSAGE ROUTINE ERRZ EQU >6A84 ERRor routine READL1 EQU >6A86 Read a line from keyboard LITS05 EQU >A002 Literal string common code EXEC EQU >A004 LINE EQU >A006 GET LINE NUMBER ROUTINE DATAST EQU >A008 SEARCH FOR NEXT "DATA" STATEM ASC EQU >A00A EXEC1 EQU >A00C EXECute a program statememt EXEC6D EQU >A00E DELINK EQU >A010 CONVER EQU >A012 CONVERT WITH WARNING SQUISH EQU >A014 VALCD EQU >A016 CONVERT STRING TO NUMBER INTRND EQU >A018 Initilize random number UBSUB EQU >A020 CLEAR BREAKPOINTS IN LN # TAB LINK1 EQU >A026 LINK to subprogram ATNZZ EQU >0022 Arctangent routine *********************************************************** * Equates for routine in MONITOR CALDSR EQU >10 CALL DEVICE SERVICE ROUTINE CFI EQU >12 CONVERT TO TWO BYTE INTEGER TONE1 EQU >34 ACCEPT TONE TONE2 EQU >36 BAD TONE CHAR2Z EQU >18 CHARACTER TABLE ADDRESS CHAR3Z EQU >4A CHARACTER TABLE ADDRESS *********************************************************** * Equates for XMLs SYNCHK EQU >00 SYNCHK XML selector FILSPC EQU >01 Fill-space utility CSTRIN EQU >02 Copy-string utility SEETWO EQU >03 SEETWO XML selector COMPCT EQU >70 PREFORM A GARBAGE COLLECTION GETSTR EQU >71 SYSTEM GET STRING MEMCHK EQU >72 MEMORY check routine: VDP CNS EQU >73 Convert number to string * Warning Default changed in >0073 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 Also for ARRAYS ASSGNV EQU >7C Assign VARIABLE SCHSYM EQU >7D Search symbol table SPEED EQU >7E SPEED UP XML CRUNCH EQU >7F Crunch an input line CIF EQU >80 Convert INTEGER to FLOATING P CONTIN EQU >81 Continue after a break SCROLL EQU >83 SCROLL THE SCREEN IO EQU >84 IO utility (KW table search) GREAD EQU >85 READ DATA FROM ERAM GWRITE EQU >86 WRITE DATA TO ERAM DELREP EQU >87 REMOVE CONTENT FROM VDP/ERAM MVDN EQU >88 MOVE DATA IN VDP/ERAM MVUP EQU >89 MOVE DATA IN VDP/ERAM VGWITE EQU >8A MOVE DATA FROM VDP TO ERAM GVWITE EQU >8B WRITE DATA FROM GRAM TO VRAM GREAD1 EQU >8C READ DATA FROM ERAM GDTECT EQU >8E ERAM DETECT&ROM PAGE 1 ENABLE SCNSMT EQU >8F SCAN STATEMENT FOR PRESCAN *********************************************************** * Temporary workspaces in EDIT VAR0 EQU >8300 TEMPORARY VARV EQU >8301 TEMPORARY ACCUM EQU >8302 # OF BYTES ACCUMULATOR (4 BYTE STPT EQU >8302 TWO BYTES MNUM EQU >8302 Ussually a counter AAA1 EQU >8302 VARY EQU >8304 PABPTR EQU >8304 Pointer to current PAB VARY2 EQU >8306 Use in MVDN only DFLTLM EQU >8306 Default array limit (10) CCPPTR EQU >8306 OFFSET WITHIN RECORED (1) * or Pointer to current column RECLEN EQU >8307 LENGTH OF CURRENT RECORD (1) CCPADR EQU >8308 RAM address of current refs * or Actual buffer address or c VARC EQU >8308 CCPADD EQU >8308 RAM address of current color CCC1 EQU >8308 CALIST EQU >830A Call list for resolving refs RAMPTR EQU >830A Pointer for crunching STADDR EQU >830A Start address - usually for co BYTES EQU >830C BYTE COUNTER * or String length for GETSTR NMPTR EQU >830C Pointer save for pscan BBB1 EQU >830C CHSAV EQU >830E CURINC EQU >830E Increment for auto-num mode VAR4 EQU >830E TOPSTK EQU >8310 Top of data stack pointer VAR5 EQU >8310 VAR6 EQU >8311 LINUM EQU >8312 Used to determine end of scan NMLEN EQU >8314 Current line for auto-num CURLIN EQU >8314 Current line for auto-num * or Starting line number for L VAR9 EQU >8316 XFLAG EQU >8316 SCAN FLAG-BITS USED AS BELOW DSRFLG EQU >8317 INTERNAL =60, EXTERNAL =0 (1) OPTFLG EQU >8317 Option flag byte during OPEN FORNET EQU >8317 Nesting level of for/next FNUM EQU >8317 Current file number for search *********************************************************** * Permanent workspace variables STRSP EQU >8318 String space begining STREND EQU >831A String space ending SREF EQU >831C Temporary string pointer SMTSRT EQU >831E Start of current statement VARW EQU >8320 Screen address (CURSOR) ERRCOD EQU >8322 Return error code from ALC STVSPT EQU >8324 Value-stack base RTNG EQU >8326 Return vector from 9900 code NUDTAB EQU >8328 Start of NUD table 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 DATA EQU >8334 Data pointer for READ LNBUF EQU >8336 Line table pointer for READ INTRIN EQU >8338 Add of intrinsic poly constant SUBTAB EQU >833A Subprogram symbol table IOSTRT EQU >833C PAB list/Start of I/O chain SYMTAB EQU >833E Symbol table pointer FREPTR EQU >8340 Free space pointer CHAT EQU >8342 Current charater/token BASE EQU >8343 OPTION BASE value PRGFLG EQU >8344 Program/imperative flag FLAG EQU >8345 General 8-bit flag BUFLEV EQU >8346 Crunch-buffer destruction leve LSUBP EQU >8348 Last subprogram block on stack * FAC EQU >834A Floating-point ACcurmulator FAC1 EQU FAC+1 FAC2 EQU FAC+2 AAA EQU FAC+2 FAC3 EQU FAC+3 FAC4 EQU FAC+4 CCC EQU FAC+4 FFF EQU FAC+4 FAC5 EQU FAC+5 FAC6 EQU FAC+6 BBB EQU FAC+6 EEE EQU FAC+6 FAC7 EQU FAC+7 FAC8 EQU FAC+8 FAC9 EQU FAC+9 FAC10 EQU FAC+10 DDD1 EQU FAC+10 FAC11 EQU FAC+11 FAC12 EQU FAC+12 FFF1 EQU FAC+12 FAC13 EQU FAC+13 FAC14 EQU FAC+14 EEE1 EQU FAC+14 FAC15 EQU FAC+15 FAC16 EQU FAC+16 FAC17 EQU FAC+17 * ARG EQU >835C Floating-point ARGument ARG1 EQU ARG+1 ARG2 EQU ARG+2 ARG3 EQU ARG+3 ARG4 EQU ARG+4 ARG5 EQU ARG+5 ARG6 EQU ARG+6 ARG7 EQU ARG+7 ARG8 EQU ARG+8 XSTLN EQU >8364 GKXB variable TEMP5 EQU >8366 ARG11 EQU ARG+11 ARG15 EQU ARG+15 ARG16 EQU ARG+16 * VSPTR EQU >836E Value stack pointer *********************************************************** * GPL Status Block STACK EQU >8372 STACK FOR DATA KEYBD EQU >8374 KEYBOARD SELCTION RKEY EQU >8375 KEY CODE EXPZ EQU >8376 Exponent in floating-point RANDOM EQU >8378 RANDOM NUMBER GENERATOR TIMER EQU >8379 TIMING REGISTER MOTION EQU >837A NUMBER OF MOVING SPRITES VDPSTS EQU >837B VDP STATUS REGISTER ERCODE EQU >837C STATUS REGISTER *********************************************************** RAMTOP EQU >8384 Highest address in ERAM RAMFRE EQU >8386 Free pointer in the ERAM RSTK EQU >8388 Subroutine stack base * (Starts at >8A) RAMFLG EQU >8389 ERAM flag STKMIN EQU >83AF Base of data stack STKMAX EQU >83BD Top of data stack PRTNFN EQU >83CE Sound - previous tone finished *********************************************************** * VDP addresses SCRNBS EQU >02E0 Screen base addr for last lin NLNADD EQU >02E2 New LiNe ADDress ENDSCR EQU >02FE END of SCReen address LODFLG EQU >0371 Auto-boot needed flag START EQU >0372 Line to start execution at * Temporary NOTONE EQU >0374 NO-TONE for SIZE in ACCEPT us * in FLMGRS (4 bytes used) SYMBOL EQU >0376 Saved symbol table pointer SPGMPT EQU >0382 Saved PGMPTR for continue SBUFLV EQU >0384 Saved BUFLEV for contiue SEXTRM EQU >0386 Saved EXTRAM for continue SAVEVP EQU >0388 Saved VSPRT for continue ERRLN EQU >038A On-error line pointer BUFSRT EQU >038C Edit recall start addr (VARW) BUFEND EQU >038E Edit recall end addr (VARA) CSNTMP EQU >0390 Use as temporary stored place * or CSN TEMPORARY FOR FAC12 TABSAV EQU >0392 Saved main symbol table ponte AUTTMP EQU >0394 AUTOLD TEMPORARY IN SIDE ERRZ SLSUBP EQU >0396 Saved LSUBP for continue SFLAG EQU >0398 Saved on-warning/break bits SSTEMP EQU >039A To save subprogram program ta SSTMP2 EQU >039C Same as above. Used in SUBPRO MRGPAB EQU >039E MERGEd temporary for pab ptr INPUTP EQU >03AA INPUT TEMPORARY FOR PTR TO PR ACCVRW EQU >03AC Temoporary used in ERRZZ, als * used in FLMGRS * or temporary for @VARW, @VARA ACCVRA EQU >03AE TRY AGAIN VALIDP EQU >03B0 Use as two values passing fro * or PTR TO STANDARD STRING IN VAL VALIDL EQU >03B2 VALIDATE code to READL1 * or Length of string in validate SIZCCP EQU >03B4 SIZE TEMPORARY FOR CCPADR SIZREC EQU >03B6 SIZE TEMPORARY FOR RECLEN * Also used as temporary in RELO *---------------------------------------------------------- * Added 6/8/81 for NOPSCAN feature PSCFG EQU >03B7 *---------------------------------------------------------- ACCTRY EQU >03B7 ACCEPT "TRY AGAIN" FLAG SIZXPT EQU >03B8 Save XPT in SIZE when "try ag SAPROT EQU >03B9 PROTECTION flag in SAVE CSNTP1 EQU >03BA CSN TEMPORARY FOR FAC10 *---------------------------------------------------------- * Flag 0: 99/4 console, 5/29/81 * 1: 99/4A console CONFLG EQU >03BB *---------------------------------------------------------- OLDTOP EQU >03BC Temporary used in ERRZZ, also * or Old top of memory for RELOCA CPTEMP EQU >03BC CCPPTR, RECLEN temp in INPUT NEWTOP EQU >03BE New top of memory for RELOCA CRNBUF EQU >0820 CRuNch BUFfer address CRNEND EQU >08BE CRuNch buffer END RECBUF EQU >08C0 Edit RECall BUFfer VRAMVS EQU >0958 Default base of value stack *********************************************************** * IMMEDITATE VALUES NUMBR EQU >00 NUMERIC validate LISTZ EQU >02 OLDZ EQU >05 RESEQZ EQU >06 SAVEZ EQU >07 MERGEZ EQU >08 DWNARR EQU >0A UPARR EQU >0B CHRTN EQU >0D BKGD EQU >20 BACKGROUND CHARACTER OFFSET EQU >60 OFFSET FOR VIDEO TABLES STRVAL EQU >65 Value in accum. is string val *********************************************************** * Editting command equates BREAK EQU >02 Break key DLETE EQU >03 Delete key INSRT EQU >04 Insert key RECALL EQU >06 Edit-buffer recall CLRLN EQU >07 Clear-line key BACK EQU >08 Back-space key FORW EQU >09 Forward-space key DOWN EQU >0A Down-arrow key UPMV EQU >0B Up-arrow key VWIDTH EQU >1C Screen width (PRINT) SPACE EQU >20 Space key QUOTE EQU >22 " DOLLAR EQU >24 $ CURSOR EQU >1E+OFFSET CURSOR EDGECH EQU >1F+OFFSET EDGE character COMMA EQU >2C , MINUS EQU >2D - *********************************************************** * PAB offset CZOPEN EQU 0 OPEN CODE CZCLOS EQU 1 CLOSE CODE FIL EQU 2 File number within BASIC(0-25 CZREAD EQU 2 READ CODE OFS EQU 3 Offset within record CZWRIT EQU 3 WRITE CODE COD EQU 4 I/O code CZREST EQU 4 RESTORE/REWIND CODE FLG EQU 5 I/O mode flag byte CZLOAD EQU 5 LOAD CODE BUF EQU 6 Start of data buffer CZSAVE EQU 6 SAVE CODE CZDELE EQU 7 DELETE CODE LEN EQU 8 Record length CZSCR EQU 8 SCRATCH CODE CNT EQU 9 Character count CZSTAT EQU 9 STATUS CODE RNM EQU 10 Record number SCR EQU 12 Screen base offset NLEN EQU 13 Length of file descriptor PABLEN EQU 14 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 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 * EQU >CA spare token 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 VAL 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 >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 *********************************************************** TITL 'FLMGR-359' *********************************************************** * GROM HEADER *********************************************************** * Branch table routines *********************************************************** BR DISPL1 DISPLAY routine BR DELET DELETE routine BR PRINT PRINT routine BR INPUT INPUT routine (not yet impele BR OPEN OPEN routine BR CLOSE CLOSE routine BR RESTOR RESTORE routine BR READ READ routine BR GETDAT Get DATA from ERAM/VDP (not u BR CLSALL CLOSE ALL OPEN FILES subrouti BR SAVE SAVE routine BR OLD LOAD routine BR LIST LIST routine BR OUTREC Output record routine BR EOF End of file routine BR ACCEPT ACCEPT routine BR SRDATA Search "DATAZ" routine BR SUBREC RECORD routine BR CHKEND Check EOS BR OLD1 A subroutine for LOAD BR MERGE MERGE a program BR GRMLST List a line out of ERAM BR GRSUB2 Read 2 bytes of data from ERA BR GRSUB3 Read 2 bytes of data from ERA * with resetting possible break BR LINPUT LINPUT statement *********************************************************** * OPEN STATEMENT HANDLER * Handle the BASIC OPNE statement. A legal syntax can only * be something like * OPEN #{exp}:{string-exp}[,{open-options}] * in which {open-option} is any of the following * DISPLAY, INPUT, VARIABLE, RELATIVE, INTERNAL, SEQUENTIAL, * OUTPUT, UPDATE, APPEND, FIXED or PERMANENT * * Each keyword can only be used once, which is being checke * with an OPTFLG-bit. For each specific option please refer * to the related routine. * Scanning stops as soon as no next field starting with a * comma can be found. * NOTE: After the actual DSR OPEN has been preformed, the * length of the record, whether VARIABLE or FIXED, * has to be non-zero. A zero length will cause an * INCORRECT STATEMENT error. *********************************************************** OPEN CALL CHKFN See if we specified any file BS ERRFE Definitely not... no # or #0 CALL CHKCON Check and search given filenu BS ERRFE *** FILE NUMBER EXISTS *** * ERROR IF NOT STOPPED ON COLON XML SPEED Must be at a BYTE SYNCHK * colon or else BYTE COLONZ * its an error CALL PARFN Parse filename and create PAB DDEC @PGMPTR Backup pgm pointer for next t OPTION XML PGMCHR Get next program character * Next field should start with a comma OPTIZ0 CEQ COMMAZ,@CHAT BR CHECK * Enter HERE after comma exit in "SEQUENTIAL" OPTIZ1 XML PGMCHR Next token please... * Treat DISPLAY and INPUT as special cases CEQ DISPLZ,@CHAT BS OPTZ6 CEQ INPUTZ,@CHAT BS OPTZ7 SUB VARIAZ,@CHAT Reduce keyword offset to 0 CHE 9,@CHAT Keyword to high BS OPERR CASE @CHAT JUST IN CASE BR OPTZ01 Option VARIABLE BR OPTZ02 RELATIVE BR OPTZ03 INTERNAL BR OPTZ1 SEQUENTIAL BR OPTZ2 OUTPUT BR OPTZ3 UPDATE BR OPTZ4 APPEND BR OPTZ5 FIXED * BR OPTZ0 PERMANENT <<<<<< * CASE 0 - "PERMANENT" ************************************ * Only check for multiple usage. Since PERMANENT is the * default, we might as well ignore it... OPTZ0 CLOG >04,@OPTFLG BR OPERR OR >04,@OPTFLG Not used ... use now BR OPTION Treat as simple default * CASE 2 - "RELATIVE" ************************************* * Select relative record file in PAB and fall through in * SEQUENTIAL code for multiple usage check. Also handle * initial file-size there. OPTZ02 OR >01,V@FLG(@PABPTR) Indicate RELATIVE RECORD * CASE 4 - "SEQUENTIAL" *********************************** * Checks for multiple usage. Remainder of syntax demads th * we have something like: * [{numeric expression}],... * In case only a comma is found, we use the default. * Everything else has to be evaluated as a numeric * expression, convertable to a 16-bit integer value. OPTZ1 CLOG >08,@OPTFLG BR OPERR OR >08,@OPTFLG First time usage, ok XML PGMCHR Check next token for default * Comma means default has been used CEQ COMMAZ,@CHAT BS OPTIZ1 CALL CHKEND Check for end of statement BS CHECK CALL CHKPAR Preform combined checking & p DST @FAC,V@RNM(@PABPTR) Non-zero result BR OPTIZ0 Scan other options * Parse and check a numeric argument in here.... CHKPAR XML PARSE If not ... parse up to comma BYTE COMMAZ CALL CHKCNV Check and convert to integer BS OPERR Oops..., someone made a mista RTN Return to caller * CASE 5 - "OUTPUT" *************************************** * Select mode code "01" and check for multiple usage. Use * MFLAG bit in OPTFLG for checking. OPTZ2 OR >02,V@FLG(@PABPTR) Mode code = 01 * CASE 6 - "UPDATE" *************************************** * Default ... Check for multiple usage only... * Test for previous usage of any mode setting OPTZ3 CLOG >01,@OPTFLG BR OPERR OR >01,@OPTFLG If not... set "MODE USED" bit BR OPTION Continue option scan * CASE 7 - "APPEND" *************************************** * Mode code "11" indicates APPEND mode. OPTZ4 OR >06,V@FLG(@PABPTR) Mode code = 11 BR OPTZ3 * CASE 1 - "VARIABLE" ************************************* * Change record type to VARIABLE and continue as FIXED OPTZ01 OR >10,V@FLG(@PABPTR) Indicate variable length mo * CASE 8 - "FIXED" **************************************** * Fixed is default. Don't change anything, unless argument * is given. In this case evaluate as numeric expression an * check for 8-bit integer range... * This routine is also used for VARIABLE !!!!! OPTZ5 XML PGMCHR Get next character CEQ COMMAZ,@CHAT Could be some argument BS OPTZ55 CALL CHKEND Could also be end of statemen BS OPTZ55 It is an EOS CALL CHKPAR Check & parse expression * Check for byte overflow (records can only be up to 255 * bytes in length) CZ @FAC BR OPERR ST @FAC1,V@LEN(@PABPTR) Select non-zero rec-size OPTZ55 CLOG >10,@OPTFLG BR OPERR OR >10,@OPTFLG Prevent to much usage of mode BR OPTIZ0 Continue option scan * CASE 3 - "INTERNAL" ************************************* * Select INTERANL file type and continue in DIPLAY OPTZ03 OR 8,V@FLG(@PABPTR) Select INTERNAL type * CASE 9 - "DISPLAY" ************************************** * Default. Only check for multiple usage of either DISPLAY * or INTERNAL... OPTZ6 CLOG >02,@OPTFLG BR OPERR OR >02,@OPTFLG Else set "DISPLAY/INTERAL" fl BR OPTION Continue... DISPLAY is defaul * CASE 10 "INPUT" ***************************************** * Same as any other I/O type definition. Mode code "10" .. * Continue in OPTZ3 OPTZ7 OR >04,V@FLG(@PABPTR) Mode code = 10 BR OPTZ3 * CLRFRE deallocates previously alocated (parts of) PAB's a * return with an error message CLRFRE CLR @MNUM Undo any allocation ST V@OFS(@PABPTR),@MNUM+1 We need the length for * that * V@OFS(@PABPTR) Was set up in PARFN routine DADD @MNUM,@FREPTR Update the first free world RTN And return OPERR CALL CLRFRE First undo the allocation ERRSYN CALL ERRZZ Then give an error BYTE 3 * SYNTAX ERROR * Continue with CHECK to conplete the actual OPEN CHECK CALL CHKEND Check EOS BR OPERR Not EOS : SYNTAX ERROR * If the user hasn't specified VARIABLE or FIXED, the * default specification depends on the file type. * Change current default (=VARIABLE) to FIXED for * RELATIVE files. CLOG >01,V@FLG(@PABPTR) RELATIVE RECORD BS G8127 CLOG >10,V@FLG(@PABPTR) VARIABLE RECORD BS G8125 FILZZ CALL CLRFRE Undo the PAB allocation BR ERRFE FILE ERROR G8125 BR G8131 Sequential file, check rec. m G8127 CLOG >10,@OPTFLG No definition yet BR G8131 OR >10,V@FLG(@PABPTR) Force VARIABLE mode G8131 CALL CDSR Call the DSR, return with err BR ERRZ2B indication in COND... DCLR V@RNM(@PABPTR) Make sure we start with recor * Check for undefined record length. The record length for * any type might be defined by the DSR CZ V@LEN(@PABPTR) BS FILZZ ST V@LEN(@PABPTR),@MNUM+1 Get record length CLR @MNUM Create two byte result and CLR V@OFS(@PABPTR) allocate - remove offset for * later use DST @MNUM,@FAC - prepare for space claim * Check for special case : no PAB's yet DCZ @IOSTRT BR G8157 DST @PABPTR,@IOSTRT Simply enter the first pointe BR G8169 G8157 DST @IOSTRT,@STADDR Search for the end of the cha G815A DCZ V*STADDR BS G8165 DST V*STADDR,@STADDR Keep on deferring BR G815A G8165 DST @PABPTR,V*STADDR Update last chain link G8169 DST @PABPTR,V@BUF(@PABPTR) Set empty buffer first XML MEMCHK Check memory overflow & strin BS ERRMEM * MEMORY FULL DSUB @MNUM,@FREPTR Compute buffer entry address DSUB @MNUM,V@BUF(@PABPTR) Correct buffer address in XML CONT Return to the parser *********************************************************** * DELETE ROUTINE * Use file # 0 for this operation. Parse the file name * string-expression as usual, and delete the PAB before * actually calling the DSR. *********************************************************** DELET CLR @FNUM Create file #0 - non-existing CALL PARFN Handle as normal PAB OPEN CALL CHKEND Check EOS first BR OPERR Not EOS : go undo PAB allocat * and print SYNTAX ERROR CLR @MNUM * Delete PAB again before calling ST V@OFS(@PABPTR),@MNUM+1 Create double byte PAB DADD @MNUM,@FREPTR Update free word pointer CALL IOCALL Preform I/O call for actual d BYTE CZDELE XML CONT *********************************************************** * CLOSE ROUTINE * Syntax could be * CLOSE #{ num exp } or CLOSE #{ num exp }:DELETE * * Possibly output pending records before closing or * deleting the file. *********************************************************** CLOSE CALL CHKFN Check for "no #" / "#0" cases BS ERRFE Not for "CLOSE" you don't CALL CHKCON Check file number etc... BR ERRFE *** FILE NUMBER NOT IN SYSTEM CALL OUTEOF Output pending records ST CZCLOS,V@COD(@PABPTR) Default to CLOSE I/O code CEQ COLONZ,@CHAT Check for ":DELETE" spec. BR G81B8 XML PGMCHR Request next input token XML SPEED Must be at a BYTE SYNCHK * "DELETE" else BYTE DELETZ * its an error ST CZDELE,V@COD(@PABPTR) Change CLOSE to DELETE G81B8 CALL CHKEND EOS? BR ERRSYN NO:SYNTAX ERROR CALL CDSR Call DSR with whatever we hav BR CLOSZ1 Reset means error.... CALL DELPAB Delete PAB and data-buffer XML CONT Return to parser routine CLOSZ1 DST V@4(@PABPTR),@ARG Save error code for message CALL DELPAB Now delete the PAB DST @FREPTR,@PABPTR Store error-code in free memo DSUB 6,@PABPTR Create standard size PAB DST @ARG,V@4(@PABPTR) Copy error-code BR ERRIO Exit to error-routine *********************************************************** * CLOSE ALL ROUTINE * CLOSE all the existing PABs ... ignore errors * * NOTE: "CLSLBL" is used in the I/O error routine to * determine if a warning should be given rather than * an error. *********************************************************** G81DD DST V*PABPTR,@PABPTR CLSAZ0 DCZ V*PABPTR Find last PAB in chain BR G81DD CALL OUTEOF Take care of pending records CLSLBL ST CZCLOS,V@COD(@PABPTR) Select CLOSE code CALL CDSR CLOSE to DSR routine CALL DELPAB Delete PAB - ignore CLOSE err CLSALL DST @IOSTRT,@PABPTR Start at beginning of chain DCZ @IOSTRT Continue until done BR CLSAZ0 RTN And return *********************************************************** * RESTORE ROUTINE * RESTORE can have any of four forms: * * RESTORE Restore to first DATA * RESTORE 20 Restore DATA pointer * RESTORE #1 Rewind file number 1 * RESTORE #1, REC 2 Position file 1 at record 2 *********************************************************** RESTOR DCLR @FAC Assume simple RESTORE CEQ NUMBEZ,@CHAT BR OLDCD CALL CHKFN Check for #<filenumber> DCZ @FAC Found equivalent of #0 BS OLDCZ0 CALL CHKCON Check and decode file # BR ERRFE Give error if file not there CALL OUTEOF Output pending record DCLR V@RNM(@PABPTR) Initialize to record 0 CALL PARREC Parse possible record clause CALL IOCALL Call DSR routine with BYTE CZREST * RESTORE I/O code XML CONT Return if no error found * Following code is for handling RESTORE to line number * within program OLDCD CALL CHKEND Check for start with end BS OLDCZ0 If we have anything else CALL LINE in FAC (double) OLDCZ0 DCEQ @ENLN,@STLN BR G8233 WRNNPP CALL WARNZZ * NO PROGRAM PRESENT * BYTE 29 B TOPL15 Go back to toplevel G8233 DST @ENLN,@LNBUF Start at beginning of program DSUB 3,@LNBUF Backup for first line number * Check against given line number OLDCZ1 CALL GRSUB3 Read 2 bytes of line ptr from * line # table which is in ERA BYTE LNBUF * Source address on ERAM/VDP * @EEE1: Destination addr on CP DCH @EEE1,@FAC Try to get something higher BR G824E DCEQ @STLN,@LNBUF Last line in program BS ERRDAT DSUB 4,@LNBUF Get next entry in line # tabl BR OLDCZ1 Try again with next line G824E DADD 3,@LNBUF Undo subtraction CALL DATAST Setup pointer for READ XML CONT Continue PARSE *********************************************************** * DISPLAY ROUTINE * DISPLAY handles all random screen access stuff.. * the AT-clause, and the BEEP, ERASE ALL and SIZE clause. *********************************************************** DISPL1 CALL DISACC Evaluate DISPLAY options BS EOLEX EXIT directly on end-of-state * If anything is specified it has to be a colon CZ @PABPTR Nothing was specified BS PRINZ1 * At this point we MUST have a colon, or else we error off * (SYNTAX ERROR) XML SPEED Check for a colon BYTE SYNCHK * and continue BYTE COLONZ * it approved BR PRINZ1 Continue with PRINT items *********************************************************** * PRINT ROUTINE * MAIN-HANDLER FOR ALL PRINT-FUNCTIONS *********************************************************** PRINT CALL INITKB Initialize keyboard I/O CEQ NUMBEZ,@CHAT Could still be anything BR PRINZ1 CALL CHKFN Check if default or open chan DCZ @FAC Default intended BS PRNZ10 CALL CHKCON Check and convert expression BR ERRFE Error if PAB not in system * PRINT allowed in output, append or update modes * Not allowed in input mode CLOG >04,V@FLG(@PABPTR) BS G8288 CLOG >02,V@FLG(@PABPTR) BS ERRFE G8288 CEQ CZREAD,V@COD(@PABPTR) BR G8293 CLR V@OFS(@PABPTR) Unpend pending INPUTs G8293 ST CZWRIT,V@COD(@PABPTR) uncomplete PRINTs CALL PRINIT Initialize some variables * Next character has to be either EOL, COMMA, or COLON CALL CHKEND BS EOLEX exit on end of statement CALL PARREC Parse possible record clause BS PRINZ0 found "," but no REC clause PRNZ10 CALL CHKEND BS EOLEX Exit on end of statement for * "PRINT #0" or "PRINT file position" CEQ COMMAZ,@CHAT BR G82BE XML PGMCHR Get next in line PRINZ0 CZ @PABPTR For "PRINT #0" BS USING * Interal type of file? CLOG >08,V@FLG(@PABPTR) BR ERRFE BR USING Execute USING clause G82BE XML SPEED Must be at a BYTE SYNCHK * colon at this point BYTE COLONZ * and error off on others BR CONPRT Make it a short branched ELSE PRINZ1 CEQ USINGZ,@CHAT BS USING End standard initialization * Test standard separators CONPRT CALL TSTSEP Test separator character CEQ TABZ,@CHAT Handle TABs BS PRTAB * At this point we've checked TAB and ; , : * The only remaining print items have to be expressions * All expressions are being handled below. * If the result of the expression is a numeric, the string * is transformed into a string and printed. Strings are * printed "as is". * The code for strings and converted numerics cannot be ma * common, since numerics may require an extra space behind * the item, depending upon the current position in the reco * Either way, the string is chunked up into little pieces * it won't fit in an empty record. XML PARSE Evaluate the expression BYTE COLONZ * Special code for INTERNAL file handling * Translate numeric datums into string format and indicate * length 8. Then check to see if the item fits within the * current record. If not, it is an error, since each item * has to fit. CALL TSTINT Test for internal files BS OTHEZ1 Nope, something different CEQ STRVAL,@FAC2 Change numerics BS G82EC ST 8,@FAC12 To string length 8 MOVE 8,@FAC,@ARG Save in ARG ST ARG,@FAC11 And use this as source CALL RSTRING Reserve some string space G82EC ST @RECLEN,@ARG Compute remaining space to EO SUB @CCPPTR,@ARG for space checking INC @ARG Make it real space CHE @ARG,@FAC7 Not enough!!!!! BS ERRFE * The = check includes length byte ST @FAC7,V*CCPADR Prestore string length DINC @CCPADR Update actual RAM address INC @CCPPTR and internal column pointer BR OTHEZ0 OTHEZ1 CEQ STRVAL,@FAC2 Print the string result BR G830D OTHEZ0 CALL OSTRNG Output the string to the reco BR CHKSEP G830D CLR @FAC11 Select standard BASIC format XML CNS Convert number to string CALL RSTRING Reserve and copy string CALL OSTRNG Output the string * Possibly add an extra space if we're not at the end of th * current record. CHE @CCPPTR,@RECLEN Enough space left BR CHKSEP ST SPACE,V*CCPADR Add trailing space ADD @DSRFLG,V*CCPADR Take care of screen I/O DINC @CCPADR Update current column address INC @CCPPTR and base 1 pointer CHKSEP CALL TSTSEP Check for legal delimiter BR ERRSYN Illegal delimiter. SYNTAX ERR * Unconditional branch * PRTAB - Print TAB as part of PRINT command PRTAB CALL TSTINT Watch out for INTERAL file ty BR ERRFE They can't handle TABs XML PGMCHR Skip TAB keyword CEQ LPARZ,@CHAT BR ERRSYN XML PARSE Parse TAB expression BYTE RPARZ CALL CNVDEF Check and convert to integer ST @RECLEN,@FAC2 Set modulo number CALL COMMOD Compute remainder CH @FAC1,@CCPPTR Position on next output recor BR G834F CALL OUTREC Output current record - no pe BS CHKSEP react on SIZE block!!! G834F CEQ @FAC1,@CCPPTR Stay here BS CHKSEP ST @FAC1,@MNUM+1 Fill with spaces XML IO OK, go ahead... fill'r up BYTE FILSPC BR CHKSEP And check separator again * Comma is similar to TAB, except that it generates at leas * one space. The exact number of spaces generated depends * upon the current position within the record. If the next * fixed tab-position is outside the record, the record, the * current record is output and the column pointer is reset * to column 1 of the next record. PRTCOM ST @CCPPTR,@MNUM+1 Compute initial # of spaces DEC @MNUM+1 Decrecment for 0 origin CLR @MNUM Clear high byte of double DIV 14,@MNUM TABs are 14 spaces apart INC @MNUM Compute next TAB-stop MUL 14,@MNUM and actual position CH @MNUM+1,@RECLEN Within this record BR PRCOL INC @MNUM+1 Convert to real position XML IO Fill spaces to new location BYTE FILSPC BR PRSEM Outside current record * The ":" (colon) separator is used to output the current * record, and proceed to position 1 of the next record. PRCOL CALL OUTREC Output the current record * The ";" (semi-colon) generates the null string. Since all * print items should be separated by a separator, this one * has been introduced to separate without moving to another * position. Notice that all separators join up here. PRSEM XML PGMCHR Skip the separator CALL CHKEND Exit on end of line BR CONPRT Continue if not end of line PRSMZ1 CZ @DSRFLG For screen output continue BS PREXIT CLOG >08,@PABPTR Check SIZE clause BS PREXIT CALL OUTREC Output current record (blank ST @CCPADR+1,@CCPPTR Compute correct value for CCP SUB >E1,@CCPPTR Subtract current screen base BR PREXIT and exit form this command * End of line exit routine for PRINT statement EOLEX CZ @DSRFLG I/O - remove blocks if BS G83A1 CLOG >04,@PABPTR " AT" clause unused BR G83A1 AND >E7,@PABPTR remove flag 3 (SIZE used) G83A1 CALL OUTREC Output pending record * Continue here if record remains pending PREXIT CZ @DSRFLG Regular file/device I/O BR G83B1 DEC @CCPPTR Back to actual offset ST @CCPPTR,V@OFS(@PABPTR) Save for next statement XML CONT Continue with next statement * End external I/O handling * Reset of code is for internal I/O handling (VDP) G83B1 CLOG >04,@PABPTR Is not used BR G83BB ST @CCPPTR,@XPT Save current value of pointer INCT @XPT CCPPTR: 1-28 G83BB CLOG >02,@PABPTR Used BEEP clause BS G83C3 CALL TONE1 ---------- BEEP ------------ G83C3 XML CONT Continue in PARSE routine * TSTINT - test for INTERAL type files, set COND if file * is NOT INTERNAL TSTINT CZ @DSRFLG Couldn't possibly be INTERNAL BR RTC CLOG >08,V@FLG(@PABPTR) Set COND according to bit 3 RTNC Return without changing COND ********* PRINT / DISPLAY USING SECTION ******************* * Arrive here after the keyword "USING" has been rejected. USING XML SPEED BYTE SYNCHK * Get first character of format BYTE USINGZ * after (double) checking USIN CEQ LNZ,@CHAT Pick up the line number BR G8430 XML PGMCHR Get high address ST @CHAT,@FAC XML PGMCHR and low address ST @CHAT,@FAC1 XML PGMCHR get next program character DST @EXTRAM,@FAC2 in SEETWO : EXTRAM value w * changed XML SPEED BYTE SEETWO * Find the line # in the progr DEX @EXTRAM,@FAC2 result in SEETWO is in EXTRA * and restore EXTRAM value BR USNGZ1 has to match exactly DINCT @FAC2 Move up to the pointer field DST @DATA,@FAC8 Save DATA pointer for READ fi CALL GRSUB2 Read 2 bytes of data from ERA BYTE FAC2 * @FAC2 : Source address on ERA DST @EEE1,@DATA @EEE1 : Destination addr. on * Put it in @DATA ST IMAGEZ,@FAC2 Search for an IMAGE token CALL SEARCH at beginning of an statement BS USNGZ1 Error if not found on this li CALL GETGFL Get first part of format stri CALL CHKSTR Prepare data for string assig DST @FAC6,@BYTES Copy actual string length in DST @FAC8,@DATA Restore original DATA pointer CALL CTSTR Create a temporary string DCZ @FAC6 BS G842E CZ @RAMTOP Data from RAM BR G8423 MOVE @FAC6,V*TEMP5,V*SREF BR G842E G8423 DST @FAC6,@FFF1 FFF1 : byte count DST @TEMP5,@DDD1 DDD1 : source address in ERAM DST @SREF,@EEE1 EEE1 : destination address on XML GVWITE Write data from ERAM to VDP G842E BR G8438 G8430 XML PARSE Parse up to the ending ":" BYTE COLONZ CEQ STRVAL,@FAC2 * IMAGE ERROR * BR USNGZ1 G8438 CEQ COLONZ,@CHAT Probably no variable list BS G8448 CALL CHKEND We better check that through BR ERRSYN something sneaky sneaked in CZ @FAC7 End of line exit BS EOLEX BR G8463 Look for format item G8448 CZ @FAC7 Exclude null strings BS USNGZ1 DST @FAC4,@ARG Get start address for string ST @FAC7,@ARG2 Get format string length USNGZ0 CEQ >23,V*ARG Found no format item yet BS G8460 DINC @ARG Try next address DEC @ARG2 Update address BR USNGZ0 Try up to the end of the stri USNGZ1 BR ERRIM * IMAGE ERROR * Now we're sure that we have at least one legal format ite * (anything with a "#" in it) G8460 ST COMMAZ,@CHAT Fake comma seperator for prin G8463 XML VPUSH Current string might be tempo DST @FAC6,@BYTES Create a workstring for outpu INC @BYTES+1 Create space for end of strin CARRY String would be too long BS USNGZ1 XML GETSTR Length whold equal format str DST @SREF,@CURLIN Create a temporary string DADD @FAC6,@SREF Compute last position in stri CLR V*SREF Set end of string indicator USNGZ3 DST V@4(@VSPTR),@FAC4 Update FAC4 area in case garb MOVE @FAC6,V*FAC4,V*CURLIN Copy format DST @CURLIN,@FAC4 Complete preps for VPUSH DST >001C,@FAC SREF = >001C DINC @FAC6 Include 0 in string length XML VPUSH Make the string temporary DST V@4(@VSPTR),@CURLIN Update current line pointer USNGZ4 CEQ >23,V*CURLIN Try to locate the next format BS G84C3 CZ V*CURLIN Not end of string yet BS G84A2 DINC @CURLIN Update pointer if not found BR USNGZ4 and continue searching G84A2 CEQ COMMAZ,@CHAT Stop on last variable BR USNGZ9 XML VPOP Restore original workstring d ST @FAC7,@BYTES Pring the current format stri DEC @BYTES Don't count the last "0" ST 1,@MNUM+1 Indicate direct output withou CALL CHKRZ0 Copy string to output record CALL OUTREC Also output current record * FAC still contains the right data, however it is easier j * to copy the original string again. DST @FAC4,@CURLIN Reconstruct CRULIN XML VPOP Copy original string info XML VPUSH Without actually removing it DSUB @FAC6,@CURLIN Reconstruct start address BR USNGZ3 Continue for the next variabl G84C3 DCEQ V@4(@VSPTR),@CURLIN Avoid "#" as count BS USNZ42 DDEC @CURLIN Backup to the sign CEQ >2E,V*CURLIN Used ".#####" BR G84DB DCEQ V@4(@VSPTR),@CURLIN BS USNZ42 DDEC @CURLIN Avoid checking count bit G84DB CEQ >2D,V*CURLIN Check for minus BS USNZ42 CEQ >2B,V*CURLIN Check for plus BS USNZ42 DINC @CURLIN It's neither, so we undo * Check for availability of variables USNZ42 CEQ COMMAZ,@CHAT Exit if no more pt item BR USNGZ9 XML PGMCHR Get next expression DSUB V@4(@VSPTR),@CURLIN Make CURLIN offset for * garbage collection XML PARSE Parse up to ";" or "," BYTE SEMICZ DADD V@4(@VSPTR),@CURLIN Reconstruct new CLN after * garbage collection DCLR @FAC8 Start with clean sheet for co DCLR @FAC11 CLR @FAC13 DST @CURLIN,@VAR4 Now start checking process CEQ >2E,V*CURLIN BS USNGZ5 CEQ >23,V*CURLIN Has to be "+" or "-" BS G8527 CEQ >2D,V*CURLIN BR G851B OR >02,@FAC11 Set explict sign flag for CNS G851B CEQ >2B,V*CURLIN BR G8527 OR >02,@FAC11 Set explict sign flag for CNS OR >04,@FAC11 Set positive sign flag for CN G8527 CALL ACCNM Accept first character plus " ST @FAC9,@FAC12 Set up FAC12 for CNS CEQ >2E,V*VAR4 Found decimal point BR G8540 USNGZ5 CLR @FAC9 Prepare for use as counter of * of # sign after decimal poin CALL ACCNM Accept some more "#"'s ST @FAC9,@FAC13 Set up FAC13 for CNS ADD @FAC12,@FAC9 FAC9 now contains the total n * of "#" sign, decimal point a * maybe a sign bit DEC @FAC9 Exclude the decimal point G8540 DCEQ >5E5E,V*VAR4 Attempt to decode ^^ BR USNZ55 DINCT @VAR4 Update address DCEQ >5E5E,V*VAR4 BR G8562 DINCT @VAR4 Update address OR >08,@FAC11 Set E-format bit for CNS CEQ >5E,V*VAR4 BR USNZ55 DINC @VAR4 Update end address OR >10,@FAC11 Set extended E-format bit for BR USNZ55 G8562 DDECT @VAR4 Correct for previous errors * At this point, CURLIN is pointing at the first item of th * format, VAR4 is pointing at the character following the i USNZ55 CHE >64,@FAC2 Detected numerical argument BS G8596 CLOG >02,@FAC11 Exclude the sign count BS G8570 DEC @FAC9 FAC9 : Number of significant G8570 CLOG >08,@FAC11 If E-format is used BS G857C CGT >0A,@FAC9 More than 10 significant digi BS ERRIM BR G8581 G857C CGT 14,@FAC9 More than 14 significant digi BS ERRIM G8581 OR >01,@FAC11 Set fixed format output it fo XML CNS Convert number to fixed forma * FAC11 points to the beginning of the string after supress * leading 0's, FAC12 contains the length of the string ST @FAC11,@FAC13 FAC13 now point to beginning * the string CLR @FAC11 Clear high byte MOVE @FAC11,*FAC13,V*CURLIN Copy the result string f * temporary DST @VAR4,@CURLIN Move pointer behind print fie BR USNGZ4 Continue after printing G8596 DST @VAR4,@FAC10 Compute total length DSUB @CURLIN,@FAC10 CH @FAC11,@FAC7 String exceeds limits BR G85B1 ST >2A,@VAR0 Prepare a "*****.." string G85A4 ST @VAR0,V*CURLIN Fill the remainder of field DINC @CURLIN Up to the end USNZ67 DCEQ @VAR4,@CURLIN Which is stored in VAR4 BR G85A4 BR USNGZ4 G85B1 DCZ @FAC6 BS USNZ68 MOVE @FAC6,V*FAC4,V*CURLIN Copy result string DADD @FAC6,@CURLIN And update address in string USNZ68 ST SPACE,@VAR0 Fill remainder with spaces BR USNZ67 USNGZ9 XML VPOP Temporary string back out ST @CURLIN+1,@BYTES Output up to the current * position SUB @FAC5,@BYTES Create one byte result BS USNZ95 Avoid empty strings ST 1,@MNUM+1 Prevent skip if field too sma CALL CHKRZ0 Preform all nomal I/O stuff USNZ95 XML VPOP Remove source format string CALL CHKEND Check for end of line exit BS EOLEX Take end of line exit XML SPEED BYTE SYNCHK * Then it HAS to be a ";" BYTE SEMICZ CALL CHKEND Now - must be EOS BS PRSMZ1 Supressed end of record, make * it a pending record BR ERRSYN SYNTAX ERROR * Collect string of "#"'s ACCNM INC @FAC9 Update item count DINC @VAR4 and item address CEQ >23,V*VAR4 Decode as many "#"'s as * possible BS ACCNM RTN Return from duty *********************************************************** * INPUT ROUTINE * First check for file or screen I/O. If file I/O then chec * for pending output and print that. If screen I/O then * check for input prompt: * Next collect the INPUT variable list on the V-stack. Get * enough input form either file or keyboard, and compare * types with entries on V-stack. After verification and * approval, assign the values. *********************************************************** INPUT CALL INITKB Assume keyboard INPUT CEQ NUMBEZ,@CHAT Might be #0 or #1-255 BR G875A CALL CHKFN Check for default #0 DCZ @FAC If luno #0 BR G860B DST @PGMPTR,V@INPUTP Save PGMPTR for "try again" DINC V@INPUTP Pass the ":" for the * "prompt" code handler * later, (using #0 will not * take care the prompt in * INPUT) CALL INPUZ2 #0 is equivalent to no # BR INPZ2 G860B CALL INSU1 Get info about file * INTERNAL files get special treatment CLOG >08,V@FLG(@PABPTR) INTERNAL file BS G86AD CZ V@OFS(@PABPTR) Fresh start BR G861E INTRZ0 CALL IOCLZ1 Get a new record through * the DSR G861E ST V@OFS(@PABPTR),@VARA+1 Regain possible offset CLR @VARA Make that a two byte constant DST V@BUF(@PABPTR),@TEMP5 Get first address DADD @VARA,@TEMP5 Compute actual address * within record INTRZ1 CALL BUG01 Get the symbol table entry * Above call fixes bug, of the given variable XML VPUSH And save it on the stack DCLR @BYTES Assume no data available CHE V@CNT(@PABPTR),@VARA+1 Pick up data BS G8643 ST V*TEMP5,@BYTES+1 Length byte first DINC @TEMP5 Update both actual address INC @VARA+1 and offset G8643 CEQ >65,@FAC2 Has to be string variable BR G8650 DST @BYTES,@FAC6 Set length of string CALL CTMPST Create temporary string BR G867E G8650 CEQ >08,@BYTES+1 * FILE ERROR BR ERRFE MOVE @BYTES,V*TEMP5,@FAC Copy value DCZ @FAC Watch out for non-scaled stuf BS G867C ST FAC7,@ARG Test for legal numeric G8661 CH 99,*ARG * FILE ERROR BS ERRFE DEC @ARG Next digit for test CEQ FAC1,@ARG BR G8661 DST @FAC,@ARG Copy in ARG for some testing DABS @ARG Be sure we're positive * If first byte after expon. byte=0 : incorrect * normalization has occured : FILE ERROR * Or >99 : illegal numeric : FILE ERROR DEC @ARG1 0 would cause underflow here CH 98,@ARG1 BS ERRFE BR G867E G867C DCLR @FAC2 Be sure FAC2 = 0 (no strings) G867E DADD @BYTES,@TEMP5 Update address and ADD @BYTES+1,@VARA+1 offset again XML ASSGNV Assign value to variable CLR V@OFS(@PABPTR) Undo allocated offsets CEQ COMMAZ,@CHAT BR G86AB XML PGMCHR Get next text character CALL CHKEND Check for end of statement BS INTRZ2 OK, EOS is fine CHE V@CNT(@PABPTR),@VARA+1 BS INTRZ0 BR INTRZ1 Still something left INTRZ2 CHE V@CNT(@PABPTR),@VARA+1 BS G86AB ST @VARA+1,V@OFS(@PABPTR) Save value of offset G86AB XML CONT And CONTINUE G86AD CALL GETVAR Collect variable list on stac DST @STADDR,@CURLIN Save it in temp DST CRNBUF,@RAMPTR Initialize crunch buffer poin CLR @RECLEN Initialize field counter ST CZREAD,V@COD(@PABPTR) Select READ operation CZ V@OFS(@PABPTR) BR INPZ31 BR INPZ3 Adjust for used record usage G86C6 ST COMMAZ,V@-1(@RAMPTR) Fake legal separator INPZ3 CALL IOCLZ1 Get next input record CLR V@OFS(@PABPTR) Reset offset within record CALL RECENT ST V@CNT(@PABPTR),@VARA Get record length G86DB CZ @VARA BS INPZ31 ADD OFFSET,V*VARW Add video offset for normal DINC @VARW Screen-type crunch - proceed DEC @VARA for entire record BR G86DB INPZ31 CALL RECENT Compute actual record entry ST V@CNT(@PABPTR),@VARA+1 Compute end of record CLR @VARA Make that a double byte DADD V@BUF(@PABPTR),@VARA Add buffer start addr DDEC @VARA Point to last position in rec CLR @VAR6 Assume no values input XML CRUNCH Scan data fields as in DATA s BYTE 1 * Indicate input stmt crunch DCZ @ERRCOD If some crunch error BR ERRINP INC @VAR6 Get correct # of fields (one ADD @VAR6,@RECLEN Update # of fields up to now CHE @VAR5,@RECLEN OK, THAT'S ENOUGH!!!! BR G86C6 DDECT @PGMPTR Backup program pointer XML PGMCHR Re-inspect last token before CALL RECENT Precompute record entry CLR V@OFS(@PABPTR) Assume no pending record CEQ COMMAZ,@CHAT Make record pending BR G8752 CEQ @VAR5,@RECLEN Enough left pending BS G8752 SUB @VAR5,@RECLEN Compute remaining # of fields SUB @RECLEN,@VAR6 # of fields used in last reco INPZ32 CEQ >82,V*VARW +OFFSET BR G873A Skip quoted strings G872E DINC @VARW CEQ >82,V*VARW +OFFSET BR G872E DINC @VARW BR INPZ32 Search for Nth data item G873A DINC @VARW Update pointer CEQ >8C,V@-1(@VARW) * ","+OFFSET = >8C BR G873A DEC @VAR6 Commas denote end of field BR INPZ32 Continue until done DSUB V@BUF(@PABPTR),@VARW Compute current offset ST @VARW+1,V@OFS(@PABPTR) Store for next round G8752 ST @VAR5,@VAR6 Copy # of variables for check DST @CURLIN,@STADDR Restore from temp BR G8786 G875A CALL INITKB Initialize some variables for DST @PGMPTR,V@INPUTP Save for "try agian" case DST @CCPPTR,V@CPTEMP Save CCPPTR, RECLEN for "try * Entry point for "try again" case INPZ33 CALL INSUB1 Put out prompt INPZ2 CALL GETVAR Get variable list on V-stack INPUZ3 CALL INSUB2 Read from the screen CLR @VAR6 Assume no values input XML CRUNCH Crunch the input line BYTE 1 * Indicate input stmt scan DST @CURLIN,@STADDR Restore from temp DCZ @ERRCOD If got some crunch error BR WRNINP XML SCROLL Scroll up after crunching ST 3,@XPT Reset XPT too - pending recor INC @VAR6 # fields = # of commas + 1 CEQ @VAR6,@VAR5 # of variables wrong BR WRNINP * Once we're here, all information should be availiable * After type verification for input and variables, push * all value entries on the V-stack. * VAR6 = VAR5 = number of variables G8786 DST @DATA,@CURLIN Save current DATA pointer DST CRNBUF,@DATA Get crunch entry DST @VAR4,@MNUM Get entry in V-stack before P INPUZ4 DADD 8,@MNUM Point to first symbol table e DST V*MNUM,@CCPPTR Get immedediate result CALL GETRAM Get value descriptor from RAM CLOG >80,V*CCPPTR Numerical value BR G87CF CALL CHKNUM Check entered value against n BR INPUZ5 Found error CZ @DSRFLG Do not check overflow in file * supply machine infinity with * appropriate sign and continu BS INPUZ6 CZ V@CSNTP1 Watch out for overflow in scr BS INPUZ6 DST @CURLIN,@DATA Restore DATA pointer BR WRZZ5 Ask for input re-enter INPUZ5 CZ @DSRFLG FILE I/O IS FATAL BS ERRINP DST @CURLIN,@DATA Restore DATA pointer on error WRNINP CALL WARNZZ Go here for simple warnings t BYTE 32 * INPUT ERROR - TRY AGAIN WRZZ5 CALL SCRZ Scroll the screen and reset C DST V@INPUTP,@PGMPTR Restore ptr to "prompt" if an DST V@CPTEMP,@CCPPTR Restore CCPPTR, RECLEN, for t DST @VAR4,@VSPTR Restore original stack ptr BR INPZ33 G87CF CALL CHKSTR Check string input BS INPUZ5 ERROR ... CHECK I/O TYPE INPUZ6 CALL GETRAM Get separation character (RAM CEQ COMMAZ,@VAR0+1 BS G87E6 DEC @VAR6 Has to be end of data BR INPUZ5 If not ... ERROR CZ @VAR0+1 BR INPUZ5 BR G87EA G87E6 DEC @VAR6 Count number of value entries BR INPUZ4 Continue * Assign cycle - assign values to variables because it resc * the program line, this code can not be udes for inperativ * statements , since the crunch buffer get's destroyed on * input. The rescan is necessary because subscripts should * evaluated AFTER all previous values have been assigned. i * INPUT I,A(I) with values 2,3 * Should assign value 3 to A(2) !!!!!!!!! * No error-checking is done here, since types are already * validated. We might get subscripts out of range though!!! G87EA DST CRNBUF,@DATA Prepare for input rescan DST @STADDR,@PGMPTR Restore token pointer for res DDEC @PGMPTR Backup on token DST @VAR4,@VSPTR Restore original stack pointe INPZ65 XML PGMCHR Get next program characters CALL CHKEND Might have , before EOS BS INPUZ7 CALL BUG01 Rescan variable name * Above call fixes bug. Get correct entry for arrays XML VPUSH Save on stack for ASSGNV CALL GETRAM Get first token of input valu CEQ STRVAL,@FAC2 Numerical case BS G880F CALL CHKNUM Check for numerical value BS INPZ67 COND should be set (valid num G880F CALL CHKSTR Get the correct string value DST @FAC6,@BYTES Length for temporary string CALL CTMPST Create temporary string INPZ67 XML ASSGNV Assign value to variable CALL GETRAM Skip separator (already check CALL CHKEND Check for end to statement BR INPZ65 Found it INPUZ7 DST @CURLIN,@DATA Restore DATA pointer XML CONT Contiue in PARSE RECENT ST V@OFS(@PABPTR),@VARW+1 Get record offset CLR @VARW Double byte value required DADD V@BUF(@PABPTR),@VARW Got it RTN AND NOW, THE END IS NEAR... CHKRM DCH SCRNBS+29,@CCPADR Not enough room for "?" BR G8840 SCRZ XML SCROLL Scroll one line for "?" DST SCRNBS+2,@CCPADR and update CCPADR accordingl G8840 RTN *********************************************************** * LINPUT ROUTINE * If file-I/O then * Get file number and check it * Internal file not allowed * End if * Get variable info * Must be string variable * If file I/O then * If no-partial-record of REC clause included * Read new record * End if * Set up copy pointers * Else * Call readline to read from keyboard * Copy to crunch buffer adjustin g for screen offset * End if * Get string of proper length * Move data into string * Assign string * Done. *********************************************************** LINPUT CALL INITKB Assume input from keyboard CEQ NUMBEZ,@CHAT If "#" - then device BR G885C CALL CHKFN Check for default = 0 DCZ @FAC #0 is assumed BS LINP10 CALL INSU1 Parse the device # CLOG >08,V@FLG(@PABPTR) BR ERRFE BR LINP10 G885C CALL INSUB1 Handle possible prompt LINP10 DST @VSPTR,@VAR4 Save original V-pointer * incase BREAK in READLN CALL BUG01 Get info about the symbol * Above call fixes bug. Get value pointer and type CEQ STRVAL,@FAC2 Must be string BR ERRMUV XML VPUSH CZ @DSRFLG If device I/O BR G88AF CZ V@OFS(@PABPTR) If new record BR G887B CALL IOCLZ1 Read the record BR G8893 G887B ST V@CNT(@PABPTR),@BYTES Get length of record DST V@BUF(@PABPTR),@TEMP5 Get address of buffer G8885 CZ @BYTES While characters in buffer BS G8893 SUB OFFSET,V*TEMP5 Remove INPUT's offset DINC @TEMP5 Increment pointer DEC @BYTES Decrement count BR G8885 Drop out directly when done G8893 CLR @TEMP5 Need a word value ST V@OFS(@PABPTR),@TEMP5+1 Restore value CLR @BYTES Need a word value ST V@CNT(@PABPTR),@BYTES+1 Get the length DSUB @TEMP5,@BYTES Calcualte length DADD V@BUF(@PABPTR),@TEMP5 Current buffer address CLR V@OFS(@PABPTR) Read next record next time BR G88E1 Else if keyboard input G88AF CALL INSUB2 Clear line and call READLN DCLR @BYTES Initialize byte counter DST @RAMPTR,@TEMP5 Initialize "crunch" pointer CEQ SPACE+OFFSET,V*VARA If space BR G88BF DDEC @VARA Don't include space on end G88BF DCGT @VARA,@VARW While not at end BS G88DC ST V*VARW,@VAR0 Get the character CEQ EDGECH,@VAR0 If not at edge character BS G88D8 SUB OFFSET,@VAR0 Subtract screen offset ST @VAR0,V*RAMPTR And put into crunch buffer DINC @BYTES Count it DINC @RAMPTR And update "crunch" pointer G88D8 DINC @VARW Update input pointer BR G88BF G88DC XML SCROLL Scroll the screen ST 3,@XPT Initialize x-pointer G88E1 CALL CTMPST Create temporary string XML ASSGNV Assign the value to it XML CONT And continue execution * Get file number and info about the file INSU1 CALL CHKCON Check & convert & search BR ERRFE Give error if required * INPUT allowed for input and update modes CLOG >02,V@FLG(@PABPTR) BR ERRFE CALL OUTEOF Output pending PRINT stuff ST CZREAD,V@COD(@PABPTR) Ensure read operation CALL PARREC Parse REC clause XML SPEED Must be at a BYTE SYNCHK * colon else BYTE COLONZ * its and error CLR @DSRFLG Clear keyboard input flag RTN * Parse and put out input prompt INSUB1 DST @PGMPTR,@STADDR Save pointer for prompt check DDEC @STADDR Backup to previous token * Go into a tight loop G890B CALL NXTCHR Get next program character BS INPZ37 Detected end of statement CEQ COLONZ,@CHAT Stop if we find a colon BR G890B DST @STADDR,@PGMPTR Backup for actual prompt scan XML PGMCHR Jump into 1st char of prompt XML PARSE And try to decode string expr BYTE COLONZ CEQ STRVAL,@FAC2 Number prompt illegal BR ERRSNM CALL OSTRNG Output the given prompt BR INPZ39 Exit without prompt backup INPZ37 DST @STADDR,@PGMPTR Backup to beginning of line ST COLONZ,@CHAT Fake prompt with ":" INPUZ2 CALL CHKRM Check for room for ? ST >9F,V*CCPADR Display ? DINCT @CCPADR Count it too INPZ39 XML SPEED Must be at a BYTE SYNCHK * colon else BYTE COLONZ * its an error RTN * Issue 'BEEP' and call read line to read form screen INSUB2 CALL CHKRM Check for room for answer DST @CCPADR,@VARW Copy current cursor position G8941 ST >80,V*CCPADR Clear the remainder DINC @CCPADR of the current line DCHE >02FE,@CCPADR Stop if we're there BR G8941 DST >7F7F,V@>02FE Replace edgechars CZ @PRTNFN If previous tone finished BR G895A CALL TONE1 ---------- BEEP ------------- G895A DEX @VAR4,@VSPTR Don't destroy V-stack on BREA CALL READLN Input a line from the keyboar DEX @VAR4,@VSPTR Restore V-stack pointer DST @STADDR,@CURLIN Save in a temp DST CRNBUF,@RAMPTR Init crunch buffer pointer RTN *********************************************************** * ACCEPT STATEMENT * Accept input anywhere on the screen. The total number of * input variables is limited to one. On an ACCEPT AT( , ), * the maximum number that can be accepted is up to the righ * margin!!!! If SIZE() is used, the maximum number is * limited to the given SIZE, or to the number of characters * remaining on the line, whichever is the lesser. *********************************************************** ACCEPT CLR V@ACCTRY Clear "try again" flag CALL DISACC Use common code for DISPLAY/A BS ERRSYN COND set means end of statem ST >FF,@ARG7 Assume we don't have VALIDATE ************ VALIDATE OPTION HANDLING ********************* CEQ VALIDZ,@CHAT Detected VALIDATE option BR G89FD XML PGMCHR Next character should start o CEQ LPARZ,@CHAT "* SYNTAX ERROR *" BR ERRSYN OR >40,@PABPTR Indicate usage of validate cl DST 1,@VARA Use VARA as length of option DCLR @VARW VARW= options used, VARW+1=#0 * stack entries for strings G898B XML PGMCHR Skip separator token CHE NUMERZ,@CHAT Could be valid option BR G89AA CHE UALPHZ+1,@CHAT It is .... BS G89AA ST 1,@ARG Select bit 0 as number option SUB NUMERZ,@CHAT Create correct offset BS SETVW Skip the shift stat. SLL @CHAT,@ARG Then select whatever option w SETVW OR @ARG,@VARW Remember options in VARW * stack entries for strings XML PGMCHR Get next token B VLIDZ0 Must use a long branch here G89AA XML PARSE Try to decode a string expres BYTE RPARZ CEQ STRVAL,@FAC2 String-number mismatch BR ERRSNM CZ @FAC7 Only count non-null strings BS VLIDZ0 ADD @FAC7,@VARA+1 Now watch out for overflow CARRY Sting truncated BR G89C0 CALL ERRZZ * STRING TRUNCATED ERROR * BYTE 19 G89C0 XML VPUSH Push the result for future re INC @VARW+1 Count number of entries on st VLIDZ0 CEQ COMMAZ,@CHAT Evaluate all fields BS G898B XML SPEED BYTE SYNCHK * Check for ")" on end BYTE RPARZ * If not, "* SYNTAX ERROR *" CALL DISPZ1 Try to evaluate further optio BS ERRSYN Premature end of statement DST @VARA,@BYTES Allocate string for character XML GETSTR DST @SREF,@ARG Get start of allocated string ST @VARW,V*ARG Get start of allocated string DINC @ARG Leave room form standard opti G89E0 CZ @VARW+1 Copy all available informatio BS G89F3 XML VPOP Regain stack-entry MOVE @FAC6,V*FAC4,V*ARG Copy string DADD @FAC6,@ARG Update destination address DEC @VARW+1 Count # of stack entries BR G89E0 G89F3 DST @SREF,V@VALIDP Copy start address of string DST @VARA,V@VALIDL and total string length CLR @ARG7 Indicate VALIDATE usage of RE G89FD DST @CCPADR,@VARW Save start address of the fie DST @VARW,@VARA Set default highest address u DST @CCPADR,@ARG2 Select absolute highest usabl DADD 290,@ARG2 290=2+32*9 maximum of 254 cha CH >FC,@VARA+1 Start at the end of line BR G8A13 DADD 4,@ARG2 G8A13 CZ @PABPTR We used some options like AT, BS G8A66 XML SPEED BYTE SYNCHK * Should always end on ":" BYTE COLONZ CLOG >02,@PABPTR Used BEEP clause BS G8A23 CALL TONE1 Wake up the user G8A23 CLOG >04,@PABPTR Used AT option, SIZE!!! BS G8A35 CLOG >08,@PABPTR Use defualt SIZE option BR G8A33 ST VWIDTH,@PABPTR+1 Limit current record length CALL SIZE1 G8A33 BR ACCPZ1 G8A35 CLOG >08,@PABPTR SIZE option used somewhere BS G8A66 * We're sure now that SIZE has been used WITHOUT the AT * option, this means that we should set XPT to point behind * the SIZE field. This can be done by adding the record * length to the current screen base address and the line's * screen base address ST @CCPADR+1,@XPT Start of with current address ADD @RECLEN,@XPT Add in the current record len SUB >DF,@XPT And subtract the lower base a * Also adjust for edge characte ST @XPT,V@SIZXPT Save it for "try again" case * in WARNING, XPT gets changed ACCPZ1 DST @CCPADR,V@SIZCCP Save for "try again" case ST @RECLEN,V@SIZREC Save for "try again" case *********************************************************** * ENTRY POINT FOR "TRY AGAIN" CASE WHEN SIZE OR ACCEPT USED *********************************************************** ACCPZ9 CLOG >80,@PABPTR Blank current field BR G8A58 ST SPACE+OFFSET,V*CCPADR G8A58 DINC @CCPADR Update screen address DEC @RECLEN Reduce count, always at least BR ACCPZ9 Loop until at end of field DDEC @CCPADR Fix end of field for maximum DST @CCPADR,@VARA Set highest location availabl DST @VARA,@ARG2 Also highest location availab * OK all set to go G8A66 CEQ 1,V@ACCTRY Skip if in "try again" BS ACCPZ7 DST @VSPTR,@VAR4 Save first entry in V-stack CALL BUG01 Collect the symbol designator * Above call fixes bug. Take care of arrays too XML VPUSH Save symbol table entry ACCPZ7 DST @VARW,V@ACCVRW Save for trying again case DST @VARA,V@ACCVRA Save for trying again case *********************************************************** * ENTRY POINT FOR "TRY AGAIN" WHEN NEITHER SIZE OR ACCEPT I *********************************************************** * In case a CALL CLEAR or ERASE ALL or CALL HCHAR has just * processed, EDGE CHARS, are gone at the bottom line ACCPZ5 CLOG >0C,@PABPTR If AT/SIZE used, maximum fiel BR AZ1 is line, so no need to worry * about it DST >7F7F,V@>02FE Put the EDGE CHAR back AZ1 DEX @VSPTR,@VAR4 Don't destroy V-stack on BREA CALL READL1 Ask for some input that can b * used DEX @VSPTR,@VAR4 Resote V-stack pointer * At this point, VARA contains the highest location used, * and VARW contains the string's start address ACCPZ2 DCEQ @VARW,@VARA Only non-empty string BS G8A9E DDEC @VARA Go to the next position CEQ SPACE+OFFSET,V*VARA BS ACCPZ2 DINC @VARA Back to the last space G8A9E XML VPOP Check the symbol designator i XML VPUSH a string or numeric variable CEQ >65,@FAC2 If numeric : empty string is BS G8AB2 DCEQ @VARA,@VARW If an empty string was entere BR G8AB2 CALL WARNZZ *** INPUT ERROR *** BYTE 32 BR ACCPZ8 G8AB2 DCLR @BYTES Compute length of input strin DST @VARW,@SREF Use SREF as temporary variabl G8AB7 DCEQ @VARA,@SREF BS G8AC8 CEQ EDGECH,V*SREF Exclude edge character BS G8AC4 DINC @BYTES G8AC4 DINC @SREF Decrement the counter BR G8AB7 G8AC8 CALL CTSTR0 Create a temporary string ACCPZ3 DCEQ @VARA,@VARW BS G8AEB CEQ EDGECH,V*VARW Skip the edge character BR G8ADC DADD 4,@VARW BR ACCPZ3 G8ADC ST V*VARW,V*SREF Copy the string SUB OFFSET,V*SREF Subtract the screen offset DINC @VARW Update pointers DINC @SREF BR ACCPZ3 Result can't be 0 G8AEB CEQ STRVAL,@FAC2 Numerical variable BS ACCPZ6 ST STRVAL,@FAC2 Create temp string CALL VALCD Use VAL code for translation BR ACCPZ6 No error - ok go on WRNSNM CALL WARNZZ Error BYTE 7 * STRING NUMBER MISMATCH ACCPZ8 CLOG >08,@PABPTR If SIZE is used BS G8B0A CLOG >04,@PABPTR Also AT is not used BR G8B0A ST V@SIZXPT,@XPT Restore XPT : in WARNING XPT G8B0A DST V@ACCVRW,@VARW Restore @VARA, @VARW DST V@ACCVRA,@VARA ST 1,V@ACCTRY Set the "try again" flag CLOG >08,@PABPTR If SIZE is not used BR G8B20 * IF ACCEPT ALSO NOT USED. GOTO "TRY AGAIN" FORM HERE CLOG >04,@PABPTR BS ACCPZ5 * IF "EITHER SIZE OR ACCEPT IS USED" THEN G8B20 DST V@SIZCCP,@CCPADR Restore CCPADR ST V@SIZREC,@RECLEN Restore RECLEN BR ACCPZ9 Go blanking the field and * "try again" ACCPZ6 XML ASSGNV Should be ok now CLOG >0C,@PABPTR Test usage of AT and/or SIZE BR ACCPZ4 At least one of the two used XML SCROLL Scroll the screen up ST 3,@XPT And reset XPT ACCPZ4 XML CONT *********************************************************** * READ STATEMENT * Assign DATA values to variables in READ-list one at a * time. Possibly search for new DATA statements if the * current DATA statement has been used. Be careful with * null entries...!!! *********************************************************** G8B38 XML PGMCHR Get character following "," READ CALL BUG01 Get pointers and correct entr * Above call fixes bug. also allow for array variabl XML VPUSH Push on Vstack for assignment CZ @DATA DATA ERROR BS ERRDAT CALL GETGFL Get next data item (RAM/GROM) CEQ STRVAL,@FAC2 BS G8B6B CEQ NUMZ,@VAR0+1 Not a numeric BR ERRSNM * string-number mismatch error CALL CHKSZ0 Build up string info DINC @FAC6 Force legal delimiter on end CALL LITS05 Copy numeric into string spac DST @SREF,@FAC12 Copy string start address DADD @FAC6,@SREF Compute end address of string DDEC @SREF Back up over delimiter CALL CONVER Convert string to number DCEQ @SREF,V@CSNTMP WRONG!!!!!!! BR ERRDAT BR G8B73 G8B6B CALL CHKSTR Check string input BS ERRDAT Give error on error CALL LITS05 Allocate string in string spa G8B73 XML ASSGNV Assign variable CALL GETGFL Get next datum from DATA stmt CEQ COMMAZ,@VAR0+1 Has to be an end of DATA BS G8B8F CZ @VAR0+1 Check for end of data BR ERRDAT DDECT @LNBUF Pointer to line # of DATA stm CLR @DATA Assume the worst - no more DA DCEQ @STLN,@LNBUF BS G8B8F DDEC @LNBUF Next line's 1st token address CALL DATAST Get next DATA statement G8B8F CEQ COMMAZ,@CHAT Worry about junk in CONT BS G8B38 XML CONT * SRDATA-Search for DATA statements (DATA statement must * be the only statement on one line) * SEARCH-also used for searching IMAGE statement. SRDATA ST DATAZ,@FAC2 Search for a DATA token SEARCH DEX @DATA,@PGMPTR Exchange with normal PC EX @CHAT,@VAR0+1 Preserve current PGM characte CZ @PRGFLG If imperative statement BR G8BB3 CZ @RAMTOP With ERAM : text itself in ER BS G8BB3 ST >FF,@RAMFLG Fake RAMFLG in this case XML PGMCHR Get first character on the li CLR @RAMFLG Restore it back BR SRDAZ1 Skip that PGMCHR G8BB3 XML PGMCHR Get first character on the li SRDAZ1 CEQ @FAC2,@CHAT Search for specific token BS SRDAZ0 CEQ @>8300,@>8300 Set COND if no DATA found SRDAZ0 DEX @DATA,@PGMPTR Exchange won't affect the CON EX @CHAT,@VAR0+1 Situation ok RTNC Return to caller with COND *********************************************************** * OLD STATEMENT * A normal load: * Get a program from an external device to VDP and * reinitialize the program pointers. Also update the line * pointer table, since the memory size of the machine on * which the program was created doesn't have to be the * same as on the current system!!!! Then check if ERAM * existed, move it to ERAM if does exist (in relocated * from) * Load a sequential file: * When program is bigger than 13.5K and ERAM exists, * maximum-length record reads are preformed to read the * file and each record is copied into the ERAM as it is * read. *********************************************************** OLD CALL OLD1 Make OLD1 a subroutine for LO B TOPL15 Go back to top level OLD1 CALL GPNAME Get program name & reinitiali XML PGMCHR Check for EOL DST @PABPTR,@STADDR Compute memory start address DADD V@NLEN-1(@PABPTR),@STADDR Add PAB-name lengt DADD PABLEN-4,@STADDR and PAB length DST @>8370,V@RNM(@PABPTR) Compute # of availiable DSUB @STADDR,V@RNM(@PABPTR) DINC V@RNM(@PABPTR) Include current address DST @STADDR,V@BUF(@PABPTR) for copy start ST CZLOAD,V@COD(@PABPTR) Select LOAD I/O code CALL CDSR Call device service routine BR OLDZ3 Not a program file, may be a * sequential file * STADDR still points to the info bytes DST V@2(@STADDR),@MNUM First test checksum DXOR V@4(@STADDR),@MNUM which is a simple XOR DCEQ @MNUM,V*STADDR Try PROTECTION option BS G8C15 DNEG @MNUM DCEQ @MNUM,V*STADDR No-ERROR BR OLDER OR >80,@FLAG Yes, set LIST/EDIT PROTECTION BR G8C17 G8C15 CLR @FLAG Otherwise clear protection G8C17 DST V@2(@STADDR),@ENLN Copy new ENLN, DST V@4(@STADDR),@STLN STLN and DST V@6(@STADDR),V@OLDTOP top of memory info DADD 8,@STADDR Point to program data DST @>8370,V@NEWTOP Set up the new top CALL RELOCA Relocate according to @>8370 OLDZ5 CZ @RAMTOP ERAM present? BS LRTOPZ * No, go back to toplevel * Yes, move from VDP to ERAM * (in relocated form) ************ Move to the ERAM from CPUBAS first *********** DST @>8370,@VAR0 DSUB @STLN,@VAR0 DINC @VAR0 # of bytes to move DST @VAR0,@CCC @CCC : Byte count for VGWITE DST CPUBAS,@BBB @BBB : Destination addr on ER DST @BBB,@STADDR For later use as the base of * current program image in REL DST @STLN,@AAA @AAA : Source address on ERAM XML VGWITE Move from VDP to ERAM DST @>8370,V@OLDTOP Set up old memory top DST @RAMTOP,V@NEWTOP Set up new memory top CALL RELOCA Relocate the program image OLDZ7 DST @STLN,@RAMFRE Reset the RAMFRE on ERAM DDEC @RAMFRE BR LRTOPZ Go back to toplevel *********************************************************** * At this point : if ERAM not exist - ERROR off else open * sequential file to load program to ERAM through VDP RAM *********************************************************** OLDZ3 CZ @RAMTOP BS OLDER * Set up PAB for OPEN * File type : Sequential file, * Mode of operation : Input * Date type : internal * Record type : Variable length records * Logical record length : 254 maximum MOVE 9,G@PAB3,V@4(@PABPTR) Build the PAB << DST @>8370,@FAC Compute the data buffer addre DSUB 253,@FAC DST @FAC,@AAA Save it for later use in VGWI DST @FAC,V@BUF(@PABPTR) CALL CDSR Call the device service routi BR ERRZ2B Return with ERROR indication * in COND * Start to read in file CALL IOCALL Read in the first record BYTE CZREAD * * Check the control information CEQ 10,V@CNT(@PABPTR) * 10 bytes contr info BR OLDER * >ABCD is the flag set at SAVE time indicating a program f DCEQ >ABCD,V*FAC BR OLDER DINCT @FAC DST V*FAC,@STLN Copy the new STLN DINCT @FAC DST V*FAC,@ENLN ENLN too DST @ENLN,@MNUM Test checksum DXOR @STLN,@MNUM DINCT @FAC DCEQ @MNUM,V*FAC Try PROTECTION option BS G8CBD DNEG @MNUM DCEQ @MNUM,V*FAC No, ERROR BR OLDER OR >80,@FLAG Yes, set LIST/EDIT PROTECTION BR G8CBF G8CBD CLR @FLAG Otherwise clear protection fl G8CBF DINCT @FAC * Check is there enough memory in ERAM DST V*FAC,@MNUM Get the old top of memory out DST @MNUM,V@OLDTOP For later use in RELOCA DSUB @STLN,@MNUM DINC @MNUM Total # of bytes in program DST @MNUM,@CCC1 For later use as the byte cou DADD CPUBAS,@MNUM Add the total # of bytes to C * Check if enough memory in ERAM GT Greater than >FFFF case BS OLDER DCH @RAMTOP,@MNUM Greater than >DFFF case BS OLDER * Move to ERAM starting from CPUBAS first, * then relocate according the new top of memory in ERAM OLZZ DST CPUBAS,@BBB @BBB : Destination addr in * ERAM FOR VGWITE DST @BBB,@STADDR For later use as base of the * current program image in ERAM RELOCA * DST >8370,@AAA @AAA has been set up before * DSUB 253,@AAA For copy start on VDP RAM * @CCC1 : Total # of bytes to move to ERAM, set up above CALL IOCALL Read in the second record BYTE CZREAD * Read in the file and each record * Should be a full (maximum length 254) record at this time * because program supposed to be bigger than 13.5K G8CE9 CEQ 254,V@CNT(@PABPTR) BR OLDER DST 254,@CCC @CCC : # of bytes to move XML VGWITE Move data from VDP to ERAM DADD 254,@BBB Update the destination addres * on ERAM DSUB 254,@CCC1 # of bytes left to move BS OLDZ9 No more bytes to move CALL IOCALL Read in the file and each rec BYTE CZREAD * Copied into ERAM as it is rea DCHE 254,@CCC1 Leave the last record alone BS G8CE9 * The record length should be the same as the # of bytes le * to move at this time CEQ @CCC1+1,V@CNT(@PABPTR) BR OLDER DST @CCC1,@CCC Set up byte count for the las XML VGWITE Move data from VDP to ERAM OLDZ9 CALL IOCALL Close the file BYTE CZCLOS DST @RAMTOP,V@NEWTOP New top of memory * V@OLDTOP : old top of memory, set up above * @STADDR : base of current program image in ERAM, set abo CALL RELOCA Relocate the program BR OLDZ7 Go to set the RAMFRE and back * toplevel PAB3 BYTE >00,>1C,>00,>00,>FE,>00,>00,>00,OFFSET * OLD error exit code, don't kill machine OLDER CALL INITPG Initialize program space BR ERRZ2 And take error exit LRTOPZ CALL KILSYM Release string space/symbol t RTN *********************************************************** * RELOCATE THE PROGRAM IMAGE ACCORDING TO THE NEW TOP OF * MEMORY: * STLN : old STLN * ENLN : old ENLN * V@OLDTOP : old top of memory * V@NEWTOP : new top of memory * @STADDR : current base for the old image *********************************************************** RELOCA DST @PABPTR,V@SIZCCP Save in temp. DST V@OLDTOP,@MNUM Get the old top of memory DST V@NEWTOP,@PABPTR Get the new top of memory DSUB @MNUM,@ENLN Compute ENLN relative to top DSUB @MNUM,@STLN Compute STLN relative to top DSUB @STLN,@STADDR Highest memory address used DCLR @MNUM Total # of bytes to be moved DSUB @STLN,@MNUM STLN = -(# bytes -1) DINC @MNUM Take care of that one DADD @PABPTR,@ENLN Compute new address of ENLN DADD @PABPTR,@STLN and STLN * @PABPTR : destination address, @STADDR : source address DST @MNUM,@ARG @ARG : byte count DST @STADDR,@VAR0 @VAR0 : source addr for MVDN DST @CCPPTR,@VAR5 Save in temp (CCPPTR, VARY2 E DST @PABPTR,@VARY2 @VARY2 : destination addr for DCEQ @RAMTOP,V@NEWTOP Relocate the program BR G8D6F in ERAM XML MVDN Move from lower memory to hig * memory one byte at a time BR G8D7E G8D6F DCLR V@SIZREC Clear a temporary variable DEX @RAMTOP,V@SIZREC Save the RAMTOP, also fake as * if ERAM not exist for MVDN in thi XML MVDN Move in VDP DEX @RAMTOP,V@SIZREC Restore RAMTOP G8D7E DST @VAR5,@CCPPTR Restore back * Update line # links according to new size DST V@OLDTOP,@MNUM Old memory top DSUB V@NEWTOP,@MNUM Stop if sizes are same BS RELOZ1 DST @STLN,@STADDR Start relocation at STLN OLDZ2 DCHE @STADDR,@ENLN and continue up to ENLN BR RELOZ1 DINCT @STADDR Skip the line # CEQ @RAMTOP,V@NEWTOP If in ERAM BR G8DAB CALL GRSUB2 Read the link out BYTE STADDR DSUB @MNUM,@EEE1 Update CALL GWSUB Write it back BYTE >0A,>58,>02 * STADDR,EEE1,2 BR G8DAF G8DAB DSUB @MNUM,V*STADDR Upadate the link G8DAF DINCT @STADDR Skip the link, next line # BR OLDZ2 And continue until done RELOZ1 DST V@SIZCCP,@PABPTR Restore from temp RTN *********************************************************** * SAVE STATEMENT * SAVE "NAME", MERGE : Save in crunched form in program * into a file one line at at time with the line number. * File opened with sequential accessed, variable-length * records (161 max), display type & output mode, move one * line number and one in text to the crunch buffer then * write to the file one line at a time. * A normal SAVE : When ERAM not exist or the size of the * program and line number table in ERAM can fit in VDP * (can be moved into VDP from ERAM once), then the save * statement saves a program image to an external device, * including all the information the system needs for * rebuilding the program image on a machine with a * different memory size, also included is a checksum for * rudimentary error checking and for PROTECTION VIOLATION * A sequential SAVE : Maximum-length records are performed * to write the file and each record is copied into the VDP * from ERAM before it is written. *********************************************************** SAVE CLOG >80,@FLAG * PROTECTION VIOLATION BR ERRPV CALL GPNAME This will also close all file * Check SAVE "NAME", MERGE or SAVE "NAME", PROTECTED first CLR V@SAPROT Clear "PROTECTED" flag XML PGMCHR CZ @CHAT EOL? BS SAZ1 Yes, no need to check any opt CEQ COMMAZ,@CHAT Has to be a comma here BR ERRSYN DCEQ >C805,V*PGMPTR Unquoted string with length 5 * has to be MERGE at this time BR G8DF4 DCEQ >4D45,V@2(@PGMPTR) "ME" of MErge BR ERRSYN If not : SYNTAX ERROR DCEQ >5247,V@4(@PGMPTR) "RG" of meRGe BR ERRSYN If not : SYNTAX ERROR CEQ >45,V@6(@PGMPTR) "E" of mergE BR ERRSYN If not : SYNTAX ERROR CZ V@7(@PGMPTR) Check for EOL BR ERRSYN Not EOL : SYNTAX ERROR BR SAVMG Go to handle this option * Has to be PROTECTED option here, crunched as unquoted str G8DF4 DCEQ >C809,V*PGMPTR Unquoted string with length 9 * has to be PROTECTED BR ERRSYN DCEQ >5052,V@2(@PGMPTR) "PR" of PRotected BR ERRSYN If not : SYNTAX ERROR DCEQ >4F54,V@4(@PGMPTR) "OT" of prOTected BR ERRSYN If not : SYNTAX ERROR DCEQ >4543,V@6(@PGMPTR) "EC" of protECted BR ERRSYN If not : SYNTAX ERROR DCEQ >5445,V@8(@PGMPTR) "TE",of protecTEd BR ERRSYN If not : SYNTAX ERROR CEQ >44,V@10(@PGMPTR) "D" of protecteD BR ERRSYN If not : SYNTAX ERROR CZ V@11(@PGMPTR) Check EOL BR ERRSYN INC V@SAPROT *********************************************************** SAZ1 CZ @RAMTOP If ERAM NOT present then BR G8E42 ***** CLEAR THE BREAKPOINT IN VDP ALONE TO SPEED UP ******* DST @STLN,@FAC8 End of line # buffer G8E33 AND >7F,V*FAC8 Clear the breakpoint DADD 4,@FAC8 Move to the next one DCH @ENLN,@FAC8 Until done BR G8E33 BR VSAVZ G8E42 CALL UBSUB Clear the breakpoint in ERAM DST @RAMTOP,@MNUM Top of memory in ERAM DSUB @STLN,@MNUM DINC @MNUM # of bytes total in ERAM DST @>8370,@VAR0 Top of memory in VDP DSUB @MNUM,@VAR0 DINC @VAR0 * Check is there enough memory in VDP to move the program * text and line number table from ERAM to VDP GT Not enough memory in VDP for sur BR GSAVE DST VRAMVS+64+256,@VAR5 * 64 bytes ar for safety bu * DSR routine give file error when loading a program which * VDP maximum size and was saved from VDP to be a program * on disk when ERAM not exist. In order to fix this proble * restrict the program memory to be 256 bytes less then th * real space in VDP when ERAM not exist. DCHE @VAR5,@VAR0 Not enough memory in VDP, do * sequential file save BR GSAVE DSUB 10,@VAR5 * 10 bytes for control informat CALL GVMOV Enough memory in VDP, move it * over and do the normal save l **************** Without ERAM, or after GVMOV ************* **************** do the normal save ************* VSAVZ DST @FREPTR,@STADDR Store additional control info DDEC @STADDR Back up some more for 2 byte DST @>8370,V*STADDR First current top of memory DDECT @STADDR DST @STLN,V*STADDR Then STLN DDECT @STADDR DST @ENLN,V*STADDR Then ENLN DDECT @STADDR Then DST @STLN,V*STADDR DXOR @ENLN,V*STADDR STLN XORed with ENLN CEQ 1,V@SAPROT Check is there PROTECTED opti BR G8E91 DNEG V*STADDR Negate the CHECKSUM to indica * LIST/EDIT protection G8E91 DST @STADDR,V@BUF(@PABPTR) Save start address in P DDEC @STADDR DST @>8370,V@RNM(@PABPTR) Compute # of bytes used DSUB @STADDR,V@RNM(@PABPTR) and store that in PAB CZ @RAMTOP If ERAM exists then BS G8EAD DST @BBB1,@STLN Restore the original STLN, EN DST @CCC1,@ENLN which points to ERAM G8EAD CALL IOCALL Call Device Service Routine f BYTE CZSAVE * SAVE operation LRTOPL CALL KILSYM Release string space/symbol t B TOPL15 Go back to toplevel *********************************************************** * Open the sequential file, set the PAB * File type : sequential file * Mode of operation : output * Data type : internal * Record type : variable length records * Logical record length : 254 maximum GSAVE MOVE 9,G@PAB3,V@4(@PABPTR) Build the PAB DECT V@FLG(@PABPTR) Put in the correct I/O mode : * Compute the data buffer address DST @>8370,@FAC DSUB 253,@FAC DST @FAC,V@BUF(@PABPTR) DST @FAC,@EEE1 Save it for later use in GVWITE CALL CDSR Call device service routine to o BR ERRZ2B Return with ERROR indication in * Put 8 bytes control info at the * beginning of the data buffer DST >ABCD,V*FAC >ABCD indentifies a program f DINCT @FAC when doing LOAD later DST @STLN,V*FAC Save STLN in control info DINCT @FAC DST @ENLN,V*FAC ENLN too DINCT @FAC DST @STLN,V*FAC DXOR @ENLN,V*FAC Save the checksum CEQ 1,V@SAPROT Check is there PROTECTED opti BR G8EFB DNEG V*FAC Negate the CHECKSUM to indica * the LIST/EDIT protection G8EFB DINCT @FAC DST @RAMTOP,V*FAC Save the top of memory info ST 10,V@CNT(@PABPTR) Set the caracter count in PAB CALL IOCALL Call device service routine BYTE CZWRIT * With I/O opcode : write, to s * the control info for the first reco * Now start to use maximum-length record to write the file * and each record is copied into the VDP from ERAM bofore i * is written DST @STLN,@DDD1 Starting address on ERAM * DST @>8370,@EEE1 @EEE1 has been set up before * DST 253,@EEE1 Starting address of the data * buffer on VDP DST @RAMTOP,@CCC1 DSUB @STLN,@CCC1 DINC @CCC1 ST 254,V@CNT(@PABPTR) Set the character count of P G8F1C DST 254,@FFF1 @FFF1 byte count XML GVWITE Move data from ERAM to VDP CALL IOCALL Call device service routine BYTE CZWRIT DADD 254,@DDD1 Update the source addr on ERA DSUB 254,@CCC1 # of bytes left to move BS GSAV1 No more bytes to save DCHE 254,@CCC1 Leave the last record alone BS G8F1C * Move the last @CCC1 bytes from ERAM to VDP DST @CCC1,@FFF1 @FFF1 : Byte count XML GVWITE Write data from ERAM to VDP ST @CCC1+1,V@CNT(@PABPTR) Update the character cou * in PAB CALL IOCALL Call device service routine BYTE CZWRIT GSAV1 CALL IOCALL BYTE CZCLOS * Close the file BR LRTOPL Continue *********************************************************** * Move the program text & line # table to VDP, and relocate GVMOV DST @STLN,@BBB1 Save STLN, ENLN for later use DST @ENLN,@CCC1 DST @STLN,@DDD1 Source addr on ERAM DST @VAR5,@EEE1 Destination addr on VDP DST @EEE1,@STADDR Use later for RELOCA DST @RAMTOP,@FFF1 DSUB @STLN,@FFF1 # of bytes to move DINC @FFF1 @FFF1 : byte count for GVWITE XML GVWITE Move from ERAM to VDP DST @RAMTOP,V@OLDTOP Set up @RAMTOP for old top * of memory DST @>8370,V@NEWTOP Set up @>8370 for new top * of memory CALL RELOCA Relocate the program DST @STLN,@FREPTR Set up @FREPTR DDEC @FREPTR RTN *********************************************************** * Save the crunched form of a program into a file. * Move the line number and text to the crunch buffer, then * write to the file one line at a time. *********************************************************** * Open the file with: * I/O opcode : OPEN * File type : SEQUENTIAL file * Mode of operation : OUTPUT * Data type : DISPLAY type data * Record type : VARIABLE LENGTH records * Data buffer address : Crunch buffer address * Logical record length : 163 (length of curnch buffer + 2 * bytes for line #) maximum SAVMG MOVE 9,G@PAB1,V@4(@PABPTR) Build PAB CALL IOCLZ1 Call the DSR routine to open fil DST @ENLN,@FAC6 Start from the first line # DSUB 3,@FAC6 @FAC6 now points to the 1st line * Write to the file from crunch bu * one line at a time G8F88 CLR @VAR0 Make it a two byte later CZ @RAMTOP If ERAM exists then BS G8FB6 DST @FAC6,@DDD1 Write the 4 bytes (line # and * line pointer) from ERAM to * crunch buffer * @DDD1 : Source address on ERA DST CRNBUF,@EEE1 @EEE1 : Destination address * on VDP DST 4,@FFF1 @FFF1 : byte count XML GVWITE Write data from ERAM to VDP DST V@CRNBUF+2,@DDD1 Line pointer now points to * length byte DDEC @DDD1 Get the length of this line * @DDD1 : Source address on ERA DINC @FFF1 @FFF1 : Byte count, coming ba * from GVWITE above, =0 XML GREAD1 Read the length byte from ERA ST @EEE1,@VAR0+1 @EEE1 : Destination addr on C DST CRNBUF+2,@EEE1 Write the text from ERAM to 3 * byte of crunch buffer * @EEE1 : Destination addr on V * @DDD1 : Source addr on ERAM DINC @DDD1 Back to point to the text DST @VAR0,@FFF1 @FFF1 : Byte count XML GVWITE Write data from ERAM to VDP BR G8FCD ERAM not exist : line # table * and text in VDP G8FB6 DST V*FAC6,V@CRNBUF PUT THE LINE # IN DST V@2(@FAC6),@FAC2 Get the line pointer out DDEC @FAC2 Line pointer now points to th * length byte ST V*FAC2,@VAR0+1 Get the length out * Move the text into the crunch buffer MOVE @VAR0,V@1(@FAC2),V@CRNBUF+2 G8FCD AND >7F,V@CRNBUF Reset possible breakpoint DINCT @VAR0 * Total length=text length+line # len ST @VAR0+1,V@CNT(@PABPTR) Store in the cahracter c CALL IOCALL Call the device service routi BYTE CZWRIT * Write DSUB 4,@FAC6 Go to the next line # DCHE @STLN,@FAC6 Finish moving all BS G8F88 DST >FFFF,V@CRNBUF Set up a EOF for the last rec ST 2,V@CNT(@PABPTR) Only write this 2 bytes CALL IOCALL Call the device service routi BYTE CZWRIT * Write CALL IOCALL Call the device service routi BYTE CZCLOS * Close the file BR LRTOPL Go back to top level PAB1 BYTE >00,>12,>08,>20,>A3,>00,>00,>00,>60 * >0820 = CRNBUF * >A3 = 163 * >60 = OFFSET *********************************************************** * MERGE ROUTINE * MERGE load a file which is in crunched program form into * the CRNBUF one record (one in) at a time then take the * line # out in FAC, text length into @CHAT, and edit it * into the program. Identify EOF by the last record which * is set up at SAVE time. *********************************************************** MERGE CALL GPNAME Close all file, set up PAB CLOG >80,@FLAG Check PROTECTION VIOLATION BR ERRPV * To fix the bug #06 in MERGE XML PGMCHR Check EOL CZ @CHAT BR ERRSYN Not EOL : SYNTAX ERROR * Open the file with * I/O opcode : OPEN * File type : SEQUENTIAL file * Mode of operation : INPUT * Data type : DISPLAY type data * Record type : VARIABLE LENGTH records * Data buffer address : crunch address * Logical record length : 163 maximum MOVE 9,G@PAB1,V@4(@PABPTR) Set up PAB INCT V@FLG(@PABPTR) Put in correct I/O mode : >14 CALL IOCLZ1 Call the device service routi * to open the file CALL IOCALL Call the device service routi BYTE CZREAD * to read DCEQ >FFFF,V@CRNBUF If 1st rec is EOF BS ERRZ2B G902A DCLR @>83D6 Read in one line and edit it * program ST V@CNT(@PABPTR),@CHAT Length of this record DECT @CHAT Text length = total length-2 * (line # length) * Put it in @CHAT for EDITLN DST V@CRNBUF,@FAC Put the line # in @FAC for ED CLR @FAC12 Make it a double byte ST @CHAT,@FAC13 * Move the text up 2 bytes MOVE @FAC12,V@CRNBUF+2,V@CRNBUF DST @PABPTR,V@MRGPAB SAVE PAB POINTER CALL EDITLN EDIT IT TO THE PROGRAM DCLR @PABPTR Clear temporary PAB pointer DEX V@MRGPAB,@PABPTR Restore old PAB pointer CALL IOCALL CALL THE DEVICE SERVICE ROUTI BYTE CZREAD * read another record or anoth * line DCEQ >FFFF,V@CRNBUF End of EOF BR G902A * Double check EOF record MERGZ1 CEQ 2,V@CNT(@PABPTR) I/O ERROR BR ERRZ2B CALL IOCALL Call the device service routi BYTE CZCLOS * close the file BR LRTOPL Go back to top level *********************************************************** * LIST ROUTINE * List lists a readable copy of the current program imnage * to the specified device. In case no device is specified, * the listing is copied to the screen. * This routine uses the fact that ERRZZ returns to the * caller if the call has been issued in EDIT which will * reinitiate the variable stuff. *********************************************************** LIST CLOG >80,@FLAG PROTECTION VILOATION ERROR < BR ERRPV < DCLR @CURLIN Create some kind of control < DCLR @CURINC for defaults < ST MINUS,@VARC Select "-" as separator < * GKXB GKLIST label CALL GTLIST GKXB pick up length * If either CURLIN or CURINC is non-zero, use it * For zero values replace the default (ENLN-3, STLN) DCZ @CURLIN BR G9094 DST @ENLN,@DDD1 Get the first lines line # DSUB 3,@DDD1 DDD1 : Source address on ERAM CALL GRSUB3 Read the line # from ERAM/VDP BYTE DDD1 * @DDD1 : Source address on ERA * Reset possible breakpoint too DST @EEE1,@CURLIN Use standard default DCZ @CURINC BR G9094 LISTZ0 CALL GRSUB3 Read last line # from ERAM/VD BYTE STLN * @STLN : Source address on ERA * Reset possible breakpoint too DST @EEE1,@CURINC @EEE1 : Destination address o * Also default for end line * Now first evaluate what we've got in CURLIN G9094 DCZ @CURINC Check for combination xxx- BR G90A6 G9098 DDEC @VARW Backup to the separation mark CEQ SPACE+OFFSET,V*VARW BS G9098 CEQ MINUS+OFFSET,V*VARW Select last BS LISTZ0 G90A6 DCHE @CURLIN,@CURINC If something like LIST 15-11 BS G90AE DST @CURLIN,@CURINC Replace byt LIST 15-15 G90AE DST @CURLIN,@FAC Prepare for line # search XML SPEED Search the line number table BYTE SEETWO DST @EXTRAM,@CURLIN Get first real line # in CURL DST @CURINC,@FAC XML SPEED BYTE SEETWO * Evaluate second line # CALL GRSUB3 Read 2 bytes of data from ERA BYTE EXTRAM * @EXTRAM : Source addr on ERAM * Reset possible breakpoint too DCH @CURINC,@EEE1 BR G90CA DADD 4,@EXTRAM Else take next lower line G90CA DST @EXTRAM,@CURINC Which could be equal to CURLI DST @CURLIN,@EXTRAM For use below by LIST DDEC @PGMPTR Backup to last CHAT XML PGMCHR Retrieve last CHAT CZ @CHAT Device name available BS G9132 CALL CLSALL Close all files that are open DST VRAMVS,@VSPTR Re-initialize the V-stack DST @VSPTR,@STVSPT And it's base XML PGMCHR Get name length in CHAT DST VRAMVS+16,@PABPTR Get entrypoint in PAB CLR @DSRFLG Indicate device I/O MOVE 9,G@PAB,V@4(@PABPTR) DST VRAMVS+16+NLEN,@CCPADR Select start address * for copy * GKXB GTLENGTH label CALL GTLENG GKXB Set length in PAB INC @FAC2 Plus length byte LISTZ1 ST @CHAT,V*CCPADR Copy the bytes one by one XML PGMCHR Get next character DINC @CCPADR CCPADR ends up with highest a DEC @FAC2 Count total # of characters BR LISTZ1 CALL IOCLZ1 Preform OPEN on DSR CLR @FAC Create double byte PAB length ST V@LEN(@PABPTR),@RECLEN Get record length ST @RECLEN,@FAC1 Get highest address used DADD @CCPADR,@FAC Compute record length DST @CCPADR,V@BUF(@PABPTR) Store it CZ @RAMTOP If ERAM exists then BS G9128 DCH @>8370,@FAC Compare with top of * VDP : if higher then 'not enough room' BS ERRIO BR G912D G9128 DCH @STLN,@FAC Not enough room BS ERRIO G912D ST 1,@CCPPTR Clear first line in output BR G9138 G9132 ST VWIDTH+3,@XPT For common code usage CALL INITKB Reset current record length G9138 CZ @RAMTOP If ERAM exist then BS G9140 CALL GRMLST Fake it : move each line to t * CRUNCH buffer form ERAM G9140 CALL LLIST List the current line SCAN Test for a break key BR LISTZ3 No key CEQ BREAK,@RKEY BS LISTZ4 LISTZ5 SCAN BR LISTZ5 LISTZ3 CZ @RAMTOP If ERAM exists BS G9156 DST @FAC14,@EXTRAM Restore the @EXTRAM G9156 DSUB 4,@EXTRAM Pointer to next line DCH @EXTRAM,@CURINC Display all lines in range BR G9138 LISTZ4 CZ @DSRFLG Device I/O -> output last rec BR G916D CALL OUTREC Output the last record CALL IOCALL Close the device properly BYTE CZCLOS B TOPL10 G916D B TOPL15 Restart the variable too * PAB image used in LIST function PAB BYTE 0,>12,0,0,0,0,0,0,OFFSET * Move each line in ERAM to CRNBUF area, put line number in * (CRNBUF), put CRNBUF+4 in (CRNBUF+2) which is the line * pointer field, put the text itself from ERAM to (CRNBUF+4 * before call LLIST, trick it by moving CRNBUF to @EXTRAM GRMLST CALL GRSUB3 Get line # from ERAM(use GREA BYTE EXTRAM * @EXTRAM : Source address on E * Reset possible breakpoint too DST @EEE1,V@CRNBUF Put it in CRNBUF DST CRNBUF+4,V@CRNBUF+2 Put CRNBUF+4 into * the line pointer field DINCT @DDD1 Get the pointer to the text * from GRAM CALL GRSUB4 Read the line pointer in (use * GREAD1) DDEC @EEE1 Get the ptr to the length byt CALL GRSUB2 Read th length from ERAM, use BYTE EEE1 * GREAD1, @EEE1 : Source addre * on ERAM ST @EEE1,@FFF1+1 Use the length as byte count * to move the text from ERAM to * VDP CRNBUF+4 area DST CRNBUF+4,@EEE1 EEE1 : Destination address on DINC @DDD1 DDD1 : Source address on ERAM XML GVWITE Move data from ERAM to VDP DST @EXTRAM,@FAC14 Save for later use DST CRNBUF,@EXTRAM Fake it RTN * SUBROUTINE TO READ 2 BYTES OF DATA FROM ERAM OR VDP WITH * THE OPTION TO RESET THE POSSIBLE BREAKPOINT GRSUB2 FETCH @FFF1 Fetch the source address on DST *FFF1,@DDD1 ERAM or VDP * @DDD1 : Source addr on ERAM * or VDP GRSUB4 CZ @RAMTOP If ERAM exists BS G91B7 DST 2,@FFF1 @FFF1 : Byte count XML GREAD1 Read data from ERAM to CPU BR G91BB G91B7 DST V*DDD1,@EEE1 Read data from VDP to CPU G91BB RTN GRSUB3 FETCH @FFF1 Fetch the source addr on ERAM DST *FFF1,@DDD1 or VDP * @DDD1 : Source addr on ERAM/V CALL GRSUB4 Do the actual read DAND >7FFF,@EEE1 Reset possible breakpoint RTN *********** REC ROUTINE *********************************** * REC(X) returns the current record to which file X is * positioned. SUBREC DST @PABPTR,@ARG Save the current PAB & set ne CALL SUBEOF Try to find the correct PAB DEX @PABPTR,@ARG @ARG : new PAB * @PABPTR : restore current PAB BR EOFZ2 Didn't find the corresponding DST V@RNM(@ARG),@FAC Obtain integer record number XML CIF Convert integer to floating XML CONT and continue *********************************************************** * EOF ROUTINE * EOF(X) returns status codes on file X. The meaning of the * result codes is: * -1 Physical End Of File * 0 Not at End Of File yet * 1 Logical End Of File *********************************************************** EOF DST @PABPTR,@ARG Save the current PAB and set * the new one in SUBEOF CALL SUBEOF Try to find the PAB somewhere BR ERRFE Can't file ST CZSTAT,@ARG2 Select status code without EX @ARG2,V@COD(@PABPTR) destorying original code CALL IOCLZ1 Get the info from DSR DEX @ARG,@PABPTR Restore original PAB and orig ST @ARG2,V@COD(@ARG) I/O code ST V@SCR(@ARG),@ARG2 And pick up STATUS MOVE 8,G@FLOAT1,@FAC Get floating 1 CLOG 3,@ARG2 Test EOF bits BS EOFZ2 No EOF indication CLOG 2,@ARG2 Physical EOF BS G9210 DNEG @FAC Make result -1 G9210 XML CONT EOFZ2 DCLR @FAC Create result 0 XML CONT FLOAT1 BYTE >40,1,0,0,0,0,0,0 * Floating point -1 SUBEOF CEQ LPARZ,@CHAT * SYNTAX ERROR BR ERRSYN XML PARSE Parse up to the matching ")" BYTE >FF CALL CHKCNV Convert and search for PAB BS ERRBV Avoid 0's and negatives bad v ST @DSRFLG,@ARG6 @DSRFLG got changed in CHKCON CALL CHKCON Check and search tiven filenu ST @ARG6,@DSRFLG @DSRFLG to changed CHKCON RTNC Condition set : file # exists *********************************************************** * LOAD / SAVE / MERGE UTILITY ROUTINE * GPNAME gets program name from OLD and SAVE * Can also be used for future implementation of REPLACE * statement. Also gives valuable contribution to updating * of program pointers (VSPTR, STVSPT, FLAG, etc...) and * creation of LOAD/SAVE PAB *********************************************************** GPNAME AND >80,@FLAG Avoid returns from ERRZZ rout CEQ STRINZ,@CHAT BS G9242 CEQ NUMZ,@CHAT * SYNTAX ERROR BR ERRSYN G9242 CALL CLSALL First close all open files CALL KILSYM Kill the symbol table DST VRAMVS+8,@PABPTR Create PAB as low as possible CLR V*PABPTR Clear PAB with ripple-move MOVE PABLEN-5,V*PABPTR,V@1(@PABPTR) XML PGMCHR Get length of file-specificat DSUB 4,@PABPTR Make it a regular PAB ST @CHAT,V@NLEN(@PABPTR) Copy name length to PAB DST V@NLEN-1(@PABPTR),@STADDR Avoid problems(bugs!) CZ @RAMFLG If ERAM not exist or imperati BR G9275 MOVE @STADDR,V*PGMPTR,V@NLEN+1(@PABPTR) BR G9284 G9275 DST @STADDR,@FFF1 @FFF1 : Byte count DST @PGMPTR,@DDD1 Source address on ERAM DST @PABPTR,@EEE1 DADD NLEN+1,@EEE1 Destination address on VDP XML GVWITE Write from ERAM to VDP G9284 DADD @STADDR,@PGMPTR Skip the string * OLD and SAVE can only be imperative CLR @DATA Clear DATA line RTN That's all folks *********************************************************** * READ / INPUT UTILITY ROUTINES *********************************************************** GETVAR DST @PGMPTR,@STADDR Save token pointer to first c CLR @VAR5 Clear # of parsed variables DST @VSPTR,@VAR4 Save first entry in V-stack * Start parse cycle for IMPUT statement GETVZ0 CHE >80,@CHAT Make sure of varialbe name BS ERRSYN XML SYM Get correct symbol table entr CLR @VAR6 Start with zero paren nesting GETVZ1 CEQ LPARZ,@CHAT Increment counter for "(" BR G92A2 INC @VAR6 G92A2 CZ @VAR6 Watch out for final balance BS G92B6 CALL CHKEND Check for unbalenced parenthe BS ERRSYN Somebody forgot something!!!! CEQ RPARZ,@CHAT Decrement for ")" BR G92B2 DEC @VAR6 G92B2 XML PGMCHR Get character following last BR GETVZ1 G92B6 XML VPUSH Push entry to V-stack INC @VAR5 Count all pushed variables CALL CHKEND Next should either be EOS or BS GETVZ2 Found it EOS!!!! XML SPEED Must be at a BYTE SYNCHK * comma else BYTE COMMAZ * its an error CALL CHKEND Check for end of statement BR GETVZ0 Haven't found it yet CZ @DSRFLG Error for keyboard I/O BR ERRSYN GETVZ2 RTN * Create a temporary string in memory. BYTES contains the l CTSTR DST >6500,@FAC2 Indicate string in FAC CTSTR0 DST @BYTES,@FAC6 Copy string length in FAC6 XML GETSTR Reserve the string DST @SREF,@FAC4 Copy start address of string DST >001C,@FAC And indicate temp. string >00 RTN * Create a temporary string from TEMP5. Length is given * in BYTES. CTMPST CALL CTSTR Create the temporary string CZ @FAC7 BS G92EB MOVE @BYTES,V*TEMP5,V*SREF G92EB RTN Non-empty * CHKNUM - Check for numeric argument CHKNUM CEQ NUMZ,@VAR0+1 BR G9303 CALL GETRAM Get string length DST @DATA,@FAC12 Store entry for conversion CLR @VAR0 Prepare for double action DADD @VAR0,@DATA Get end of data field CALL CONVER Convert data to FAC # * Conversion should also end at end of field DCEQ @DATA,V@CSNTMP Set COND according to equalit G9303 RTNC Back to caller GETGFL ST @RAMTOP,@FAC3 Select target memory GETDAT CZ @FAC3 Get everything from RAM BR G9314 GETRAM ST V*DATA,@VAR0+1 Get data in VAR0+1 CLR @FAC3 Be sure FAC3 = 0 !!!! BR G9320 G9314 DST 1,@FFF1 FFF1 : byte count DST @DATA,@DDD1 DDD1 : source addr on ERAM XML GREAD1 Read data from ERAM ST @EEE1,@VAR0+1 EEE1 : Destination addr on CP G9320 DINC @DATA Go to next datum for next tim RTN CHKSTR DCLR @FAC6 Assume we'll have an empty st CEQ STRINZ,@VAR0+1 BS CHKSZ0 CEQ NUMZ,@VAR0+1 See ............ BR EMPSTR CHKSZ0 CALL GETDAT Next datum is length byte CLR @FAC6 Be sure high byte = 0 !!!! ST @VAR0+1,@FAC7 Prepare FAC for string assign DST @DATA,@TEMP5 Save string addr for assignme DADD @FAC6,@DATA Update DATA for end of field RTN * Empty strings are handled below EMPSTR CEQ COMMAZ,@VAR0+1 BS G9348 CALL DATEND Check for end of data stateme BR RTC Return with COND if not EOS G9348 DDEC @DATA Backup data pointer for empti RTN DATEND EX @VAR0+1,@CHAT CALL CHKEND Check for EOS (=EOL or "::") EX @VAR0+1,@CHAT Restore original situation RTNC *********************************************************** * OPEN / CLOSE / RESTORE UTILITY ROUTNE * CHKFN - Check for token = "#" and collect and check * filenumber. Also convert filenumber to (two byte) integer * and check for range 0<x<256 *********************************************************** CHKFN XML SPEED Must be at a BYTE SYNCHK * '#' else BYTE NUMBEZ * its an error XML PARSE Parse argument up to ":" BYTE COLONZ * Code to check for negative or zero result in floating poi * accumilator. If not... convert to integer and return two * byte integer in FAC CHKCNV CEQ STRVAL,@FAC2 String/number mismatch BS ERRSNM CLR @FAC10 Clear error-code byte XML CFI Convert to two byte integer CZ @FAC10 BAD VALUE ERROR BR ERRBV CLOG >80,@FAC Negative result BR RTC DCZ @FAC And return with COND set/rese RTNC CHKCON ST @FAC1,@FNUM Move result into FNUM * Check for high byte not zero (>0255) CZ @FAC Bad value error BR ERRBV * Search routine - Search for a given file number in the * chain of allocated PABs. * IOSTRT contains the start of the PAB - chain DST @IOSTRT,@PABPTR Get first link in the chain * Check for last PAB in the chain and exit if found CHKFZ1 DCZ @PABPTR Check if file # is correct BS G938F CEQ @FNUM,V@FIL(@PABPTR) BS RTC DST V*PABPTR,@PABPTR Try the next PAB BR CHKFZ1 RTC CEQ @>8300,@>8300 Force COND to "SET" G938F RTNC Exit with no COND change *********************************************************** * OUTEOF outputs the last record if this record is * non-empty, and if the PAB is open for non-imput mode * (UPDATE, APPEND or OUTPUT). *********************************************************** OUTEOF CLR @DSRFLG CEQ CZWRIT,V@COD(@PABPTR) Non-input mode BR G93A5 CZ V@OFS(@PABPTR) Non-empty record BS G93A5 CALL PRINIT Initiate for output CALL OUTREC Output and remove pending con G93A5 RTN Return to whoever called *********************************************************** * DELPAB routine - delete a given PAB from chain under the * assumption that the PAB exists *********************************************************** * First compute start and end address for block move DELPAB DST V@BUF(@PABPTR),@STADDR Get lowest used address DDEC @STADDR Make that an addr following P CLR @CCPADR Get highest addr in CCPADR (2 ST V@NLEN(@PABPTR),@CCPADR+1 complete the two byte ADD PABLEN-1,@CCPADR+1 Add PAB length-1 DADD @PABPTR,@CCPADR Compute actual addr within RA DCEQ @PABPTR,@IOSTRT Watch out for first PAB BS G93E6 DST @IOSTRT,@MNUM Figure out where link to PAB G93C2 DCEQ @PABPTR,V*MNUM Continue while not found BS G93CE DST V*MNUM,@MNUM Defer to next link in chain BR G93C2 Short end for code-savings G93CE DST V*PABPTR,V*MNUM Copy link over deleted PAB DCZ V*MNUM Adjust link only if not done BS G93E0 DADD @CCPADR,V*MNUM Add deleted # of bytes for DSUB @STADDR,V*MNUM link correction G93E0 DST V*MNUM,@PABPTR Get new PABPTR BR G93F7 G93E6 DST V*PABPTR,@IOSTRT Update first link DCZ @IOSTRT Only adjust if not last link BS G93F4 DADD @CCPADR,@IOSTRT Add deleted # of bytes DSUB @STADDR,@IOSTRT G93F4 DST @IOSTRT,@PABPTR Get new PABPTR * Move the bytes below the deleted block up in memory. This * includes both variables and PABs G93F7 DST @STADDR,@MNUM Get # of bytes to move DSUB @FREPTR,@MNUM DST @CCPADR,@CCPPTR Save destination address G9400 DCZ @MNUM BS G9411 ST V*STADDR,V*CCPADR Move byte by byte DDEC @STADDR Update source DDEC @CCPADR and destination pointers DDEC @MNUM Also update counter value BR G9400 G9411 DSUB @STADDR,@CCPADR Compute # of bytes of old PAB DCZ @PABPTR Avoid trouble with last PAB BS G9431 G9418 DCZ V*PABPTR Ad infinitum (or fundum) BS G942C DADD @CCPADR,V*PABPTR Adjust link to next PAB DADD @CCPADR,V@BUF(@PABPTR) Update the buffer link DST V*PABPTR,@PABPTR Get next link in chain BR G9418 G942C DADD @CCPADR,V@BUF(@PABPTR) Update buffer link * Adjust symbol table links G9431 DCZ @SYMTAB BS G94B4 DCGE @CCPPTR,@SYMTAB Only update lower links BS G94B4 DADD @CCPADR,@SYMTAB Get symbol table pointer back DST @SYMTAB,@PABPTR Get pointer for update DELPZ1 CZ @RAMTOP BR DELPZ2 DCGE @STLN,V@4(@PABPTR) If imperative BS G9451 DELPZ2 DADD @CCPADR,V@4(@PABPTR) Adjust name pointer G9451 CGE 0,V*PABPTR If string-fix breakpoints BS G949B ST >07,@FAC Mask to get # of dims AND V*PABPTR,@FAC Get # of dims DST @PABPTR,@FAC2 Pointer to 1st dim max DADD 6,@FAC2 or string pointer DST 1,@FAC6 Number of pointers to change CLR @FAC4 For 2 byte use of option base G946B CZ @FAC While more dimendions BS G9483 ST 1,@FAC5 Assume option base 0 SUB @BASE,@FAC5 But correct if base 1 DADD V*FAC2,@FAC4 Get dim maximum DMUL @FAC6,@FAC4 Multiply it in DEC @FAC Next dim DINCT @FAC2 B G946B * FAC2 now points at the 1st string pointer * FAC6 contains the # of pointers that need to be changed G9483 DCZ @FAC6 While pointers to cheange BS G949B DST V*FAC2,@FAC Get pointer to string DCZ @FAC If sting is non-null BS G9495 DST @FAC2,V@-3(@FAC) Fix backpointer G9495 DINCT @FAC2 Point to next pointer DDEC @FAC6 One less pointer to change BR G9483 G949B DCZ V@2(@PABPTR) BS G94B4 DCGE @CCPPTR,V@2(@PABPTR) BS G94B4 DADD @CCPADR,V@2(@PABPTR) Adjust next value link DST V@2(@PABPTR),@PABPTR Next entry BR DELPZ1 G94B4 DADD @CCPADR,@FREPTR Update free word pointer RTN *********************************************************** * CNVDEF - Convert to 2 byte integer and default to 1 on * negative or 0 .... *********************************************************** CNVDEF CALL CHKCNV Check and convert BR CNVDZ0 DST 1,@FAC Default to 1 or minus and 0 CNVDZ0 RTN And return without COND set *********************************************************** * PARREC parses a possible REC clause in INPUT, PRINT or * RESTORE. In case a comma is detected without a REC clause * following it, the COND is set upon return. In case a REC * clause is specified for a file opened for SEQUENTIAL * access, a * FILE ERROR is given. *********************************************************** PARREC CEQ COMMAZ,@CHAT Only check if we have a "," BR G94EE XML PGMCHR Check next token for REC CEQ RECZ,@CHAT May be USING clause BR RTC CLOG 1,V@FLG(@PABPTR) BS ERRFE XML PGMCHR Get first character of expres CALL OUTEOF Output possible pending outpu CLR V@OFS(@PABPTR) Clear record offset XML PARSE Translate the expression in R BYTE COLONZ CALL CHKCNV Check numeric and convert to CGE 0,@FAC 2 byte integer, Bad Value BR ERRBV DST @FAC,V@RNM(@PABPTR) Store actual record number G94EE RTN *********************************************************** * DISPLAY / ACCEPT UTILITIES *********************************************************** DISACC CALL INITKB PABPTR is used as flag (no DS DISPZ1 CEQ ERASEZ,@CHAT Check for ERASE ALL BR G9518 CLOG 1,@PABPTR already used once BR ERRSYN XML PGMCHR Check next token for ALL XML SPEED BYTE SYNCHK * has to be ALL BYTE ALLZ ALL BKGD+OFFSET Clear screen to background co ST 3,@XPT Reset pending output pointer CLOG 4,@PABPTR Didn't use AT yet BR G9513 ST 1,@CCPPTR Reset column pointer DST SCRNBS+2,@CCPADR and screen base address G9513 OR 1,@PABPTR Set "ERASE USED" flag BR DISPZ1 Try next token G9518 CEQ BEEPZ,@CHAT delay action for BEEP BR G9529 CLOG 2,@PABPTR Use it only once BR ERRSYN OR 2,@PABPTR No syntax error detected here XML PGMCHR Evaluate next token BR DISPZ1 Get set for second pass G9529 CEQ ATZ,@CHAT Generate "AT" clause BR G9571 CLOG 4,@PABPTR Second usage not BR ERRSYN XML PGMCHR allowed.... XML SPEED BYTE SYNCHK * Skip left parenthesis BYTE LPARZ XML PARSE Now parse any expression BYTE COMMAZ XML SPEED BYTE SYNCHK * Check for "," and skip it BYTE COMMAZ CALL CNVDEF Convert to 2 byte numeric ST 24,@FAC2 Convert modulo 24 (# screen l CALL COMMOD Compute remainder DEC @FAC1 Convert back to 0 (range was MUL 32,@FAC1 Convert to line base address DST @FAC1,@CCPADR And repalce CCPADR XML PARSE Parse column expression BYTE RPARZ XML SPEED BYTE SYNCHK * Check for ")" at end BYTE RPARZ CALL CNVDEF Again convert to two byte int ST VWIDTH,@FAC2 Convert modulo video width CALL COMMOD Compute remainder ST @FAC1,@CCPPTR Select current column DADD @FAC,@CCPADR Compute full address DINC @CCPADR Adjust for column 0 (offset-1 OR 4,@PABPTR Set "AT-CLAUSE" used flag OR 32,@PABPTR Set "NON-STANDARD SCREEN ADDR BR DISPZ1 Continue for next item G9571 CEQ SIZEZ,@CHAT "SIZE" clause BR G95A0 CLOG 8,@PABPTR Only use once BR ERRSYN XML PGMCHR Get character following the S CEQ LPARZ,@CHAT has to open "(" BR ERRSYN XML PARSE And close again ")" BYTE VALIDZ CGE 0,@FAC Change to positive argument BS G958F DNEG @FAC For ACCEPT statement with siz OR >80,@PABPTR indicate in highest bit G958F CALL CHKCNV BS ERRBV * BAD VALUE CZ @FAC Also for args >255 (less then BR ERRBV ST @FAC1,@PABPTR+1 Copy to PABPTR (always used) OR 8,@PABPTR Prevent further use BR DISPZ1 and go on G95A0 CEQ VALIDZ,@CHAT Exclude VALIDATE option BS G95B9 * Start evaluating ERASE clause here CLOG 8,@PABPTR BS CHKEND CALL SIZE1 Evaluate field defined in SIZ * 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 CHKEND CLOG >80,@CHAT BS G95B7 CHE TREMZ+1,@CHAT BR RTC G95B7 CZ @CHAT Set COND according to CHAT G95B9 RTNC *********************************************************** * NXTCHR - Get next program character - skip all strings, * numerics and line references... *********************************************************** NXTCHR CALL CHKEND Check for end of statements BS RTC Avoid end of statement CEQ STRINZ,@CHAT Skip all strings BS NXTCZ0 CEQ NUMZ,@CHAT and numerics/unquoted string BR G95D5 NXTCZ0 XML PGMCHR Get string length ST @CHAT,@FAC1 Make that a double please... CLR @FAC Hic.... Oops, sorry DADD @FAC,@PGMPTR Back to the serious stuff BR G95DC G95D5 CEQ LNZ,@CHAT Line # = skip 2 tokens BR G95DC DINCT @PGMPTR <----------- That's the skip G95DC XML PGMCHR Get the next token RTN *********************************************************** * PRINT / DISPLAY UTILITES * Use the parameters specified in SIZE for further * evaluation of the limited field length *********************************************************** SIZE1 CLOG 4,@PABPTR Not "AT" clause used BR G95FC CEQ 1,@CCPPTR Might have to print current BS G95FC ST @CCPPTR,@FAC Compute final position after ADD @PABPTR+1,@FAC in FAC and compare with reco DEC @FAC CH @RECLEN,@FAC Size clause too long BR G95FC * We can't get here for AT( , ) output, since right margin * limited there CALL OUTREC Advance to next line CALL SCRO Scroll the screeen G95FC SUB @CCPPTR,@RECLEN Limit field size to available INC @RECLEN space... including current p CH @PABPTR+1,@RECLEN BR INITZ1 ST @PABPTR+1,@RECLEN Only accept if available BR INITZ1 Reinitialize CCPPTR * Copy (converted) numerical datum in string RSTRING ST @FAC12,@BYTES+1 Get actual string length CLR @BYTES Create double byte value CALL CTSTR Create a temporary string MOVE @BYTES,*FAC11,V*SREF Copy value string RTN * COMMOD - Compute FAC module FAC2 COMMOD DIV @FAC2,@FAC Compute remainder CZ @FAC1 Avoid zero remainders BR G9624 ST @FAC2,@FAC1 Assume maximum remainder G9624 CLR @FAC Clear upper byte RTN * TSTSEP tests for separator in print and branches to the * correct evaluation routine. * If no separator is found, simple return. * Test case end of line TSTSEP CALL CHKEND BR TSTSZ0 DST EOLEX,*SUBSTK Replace return address with E TSTSZ0 CHE COMMAZ,@CHAT BR TSTSZ1 CH COLONZ,@CHAT BS TSTSZ1 DST PRSEM,*SUBSTK Expect it to be a ";" CALL TSTINT Test for INTERNAL files BR TSTSZ1 Treat all separators as ";" CEQ COMMAZ,@CHAT BR G964F DST PRTCOM,*SUBSTK G964F CEQ COLONZ,@CHAT BR TSTSZ1 DST PRCOL,*SUBSTK TSTSZ1 RTN * PARFN - Parse string expression and create PAB automatica * continue in CSTRIN for copy string to PAB * Exit on non-string values * * First evaluate string expression PARFN XML PARSE Parse up to next comma <<< BYTE COMMAZ * <<< CEQ STRVAL,@FAC2 Check for "STRING" <<< BR ERRSNM DST @FAC6,@MNUM Copy length byte in MNUM ADD PABLEN,@MNUM+1 Account for PAB length+contro XML VPUSH Save start of string somewher DST @MNUM,@FAC Setup for MEMCHK - check for XML MEMCHK memory overflow BS ERRMEM * MEMORY FULL XML VPOP Restore all FAC information a DSUB @MNUM,@FREPTR Update free word pointer DST @FREPTR,@PABPTR Assign PAB entry address DINC @PABPTR Correct for byte within PAB CLR V*PABPTR Clear PAB plus control info MOVE PABLEN-1,V*PABPTR,V@1(@PABPTR) Ripple byte ST @MNUM+1,V@OFS(@PABPTR) Save length of PAB ST @FAC7,@MNUM Compute # of bytes in name ST @FAC7,V@NLEN(@PABPTR) Store name length ST @FNUM,V@FIL(@PABPTR) Copy file number in PAB DST @PABPTR,@CCPADR Get start addr for string des DADD NLEN+1,@CCPADR Add offset to actual start ad * TRICKY - OPTFLG also results offset added in CSTRIN CLR @OPTFLG Clear all option flags XML IO CSTRIN I/O UTILITY BYTE CSTRIN RTN *********************************************************** * OUTREC * OUTREC and INITRC are used to output a record to either * screen or external I/O devices, and to initiate pointers * for further I/O. *********************************************************** OUTREC ST @RECLEN,@MNUM+1 Compute number of characters INC @MNUM+1 positions we should fill CZ @DSRFLG Screen I/O BS G96D3 XML IO Fill the remainder of the rec BYTE FILSPC * with appropriate fillers CLOG 8,@PABPTR block output on size BR RTC CLOG 4,@PABPTR "AT CLAUSE USED" BS SCRO * Next test for xing the end of screen DADD 4,@CCPADR CHE 3,@CCPADR BR INITZ1 DST 2,@CCPADR Restart at upper left hand * corner of screen INITZ1 ST 1,@CCPPTR Reset current column pointer RTN SCRO XML SCROLL Scroll the screen one line ST 1,@CCPPTR Reinitialize CCPPTR BR INTKB0 and reinitialize * This is also entry for last record output G96D3 CLOG >10,V@FLG(@PABPTR) FIXED records BR G96E2 ST @RECLEN,@MNUM+1 Ready for space filling INC @MNUM+1 Move to first position outsid * record XML IO And do it up to end of record BYTE FILSPC G96E2 DEC @CCPPTR Update last character positio ST @CCPPTR,V@CNT(@PABPTR) Store # of characters CLR V@OFS(@PABPTR) Undo pending record offsets CALL IOCALL Call DSR BYTE CZWRIT * for WRITE mode CLR @CCPADR+1 Get address at buffer start BR PRZZ0 * PRINIT initializes the variable CCPADR, CCPPTR, RECLEN an * DSRFLG, for a given PABPTR. PRINIT CLR @DSRFLG Indicate external I/O in DSRF ST V@LEN(@PABPTR),@RECLEN Pick up record length ST V@OFS(@PABPTR),@CCPADR+1 Get offset in record PRZZ0 ST @CCPADR+1,@CCPPTR Compute columnar position INC @CCPPTR And convert from offset CLR @CCPADR Clear upper byte DADD V@BUF(@PABPTR),@CCPADR Compute actual address RTN *********************************************************** * OSTRNG - Copy the value of the string expression to the * screen. *********************************************************** OSTRNG ST @FAC7,@BYTES Pick up the string length G9711 CZ @BYTES Output as many records as req BS G973E * CHKREC check available space in current record. * If the string to be output is too long, it is chuncked up * into digestable pieces. If the current record is partly * filled up, it is output before any chuncking is done. CHKREC ST @CCPPTR,@MNUM+1 Use MNUM for current offset i CHKRZ0 ST @RECLEN,@MNUM Compute remaining area SUB @CCPPTR,@MNUM between column and end INC @MNUM Also count current column CHE @BYTES,@MNUM Won't fit in current record BS G9730 CEQ 1,@MNUM+1 Unused record BS CHKRZ1 CALL OUTREC Output whatever we have BR CHKREC And try again RTN G9730 ST @BYTES,@MNUM Use actual count if fit CHKRZ1 SUB @MNUM,@BYTES Update remaining chars count ADD @MNUM,@CCPPTR Also new column pointer XML IO Copy string to output BYTE CSTRIN BR G9711 Continue as long as needed G973E RTN *********************************************************** * INITKB - Initialize the variable needed for keyboard outp *********************************************************** INITKB CLR @PABPTR Don't use any DISPLAY options ST OFFSET,@DSRFLG Load for correction of screen ST 1,@CCPPTR Assume un-initialized XPT CH 2,@XPT * Patch for un-initialized XP BR G9751 ST @XPT,@CCPPTR Initialize CCPPTR DECT @CCPPTR Correct for incorrect XPT off G9751 ST VWIDTH,@RECLEN Get video screen width INTKB0 ST @CCPPTR,@CCPADR+1 Initialize screen address CLR @CCPADR Clear upper byte CCPADR DADD SCRNBS+1,@CCPADR Add start-addr plus comenstat RTN IOCALL FETCH @FAC12 I/O code to FAC12 (BUG!!!) ST @FAC12,V@COD(@PABPTR) Pick up the I/O code IOCLZ1 CALL CDSR Call the DSR routine BR ERRZ2 Give I/O error on error RTN Or else return * DSR CALL ROUTINE - NORMAL ENTRY CDSR ST OFFSET,V@SCR(@PABPTR) Always set screen offse MOVE 30,@FAC,V@>03C0 Save FAC area DST @PABPTR,@FAC12 Get PAB pointer in FAC DADD NLEN,@FAC12 Get PAB pointer in FAC AND >1F,V@FLG(@PABPTR) Clear error bits for ON ERRO * time, I/O process can still be * continued CALL CALDSR Call actual DSR link routine BYTE 8 MOVE 30,V@>03C0,@FAC * MOVE does not affect status BS CDSRZ0 ERROR = ERROR = ERROR CLOG >E0,V@FLG(@PABPTR) Set COND if no error CDSRZ0 RTNC * ERROR MESSAGES ERRZ2B CALL CLRFRE Undo allocation of PAB * First check is it error coming from AUTOLD * If it is then do not print the error messege and * go back to TOPL02 ERRZ2 MOVE 2,G@TOPL02,V@AUTTMP DCEQ V@AUTTMP,@RSTK+2 BR G97A9 ST RSTK+2,@SUBSTK RTN *********************************************************** * Next code is to avoid recursion of errors in CLSALL * routine. If this entry is taken from CLSALL, the stack * will contain CLSLBL as a retrun address in the third leve *********************************************************** G97A9 SUB 4,@SUBSTK DCEQ CLSLBL,*SUBSTK BR G97B8 WRNIO CALL WARNZZ Give warning to the user BYTE 35 * I/O ERROR but warning RTN And return to close routine G97B8 ADD 4,@SUBSTK Back up two levels for OLD/SA ERRIO CALL ERRZZ BYTE 36 * I/O ERROR * ERROR messages called in this file ERRSNM CALL ERRZZ BYTE 7 * STRING-NUMBER MISMATCH ERRIM CALL ERRZZ BYTE 10 * IMAGE ERROR ERRMEM CALL ERRZZ BYTE 11 * MEMORY FULL ERRBV CALL ERRZZ BYTE 30 * BAD VALUE ERRINP CALL ERRZZ BYTE 32 * INPUT ERROR ERRDAT CALL ERRZZ BYTE 33 * DATA ERROR ERRFE CALL ERRZZ BYTE 34 * FILE ERROR ERRPV CALL ERRZZ BYTE 39 * PROTECTION VIOLATION ERRMUV CALL ERRZZ BYTE 9 * IMPROPERLY USED NAME * Other errors called in file * ERRSYN * SYNTAX ERROR BYTE 3 * ERRST * STRING TRUNCATED ERROR BYTE 19 * WRNNPP * NO PROGRAM PRESENT BYTE 29 * WRNINP * INPUT ERROR (WARNING) BYTE 32 * ERRIO * I/O ERROR BYTE 36 * WRNIO * I/O ERROR (WARNING) BYTE 36 * WRNSNM * STRING NO. MISMATCH (WARNING) BYTE 7 *********************************************************** * The following section has been added to fix bugs in INPUT * ACCEPT, and LINPUT statements. *********************************************************** BUG01 CHE >80,@CHAT Make sure of variable name BS ERRSYN XML SYM Get the information of the XML SMB variable. RTN *********************************************************** * GKXB CODE HERE GTLENG ST @CHAT,@FAC+2 Moved from LIST routine ST @XSTLN,V@8(@PABPTR) Store length RTN and return *********************************************************** AORG >1800 *********************************************************** ALCEND DATA >205A,>24F4,>4000,>AA55 DATA >2038,>2096,>2038,>217E DATA >2038,>21E2,>2038,>234C DATA >2038,>2432,>2038,>246E DATA >2038,>2484,>2038,>2490 DATA >2038,>249E,>2038,>24AA DATA >2038,>24B8,>2038,>2090 DATA >0000,>0000,>0000,>0000 DATA >0000,>0000,>0000,>0000 DATA >0000,>0000,>0000,>0000 DATA >0000,>0000,>0000,>0000 DATA >6520,>C060,>2004,>0281 DATA >4000,>130E,>C001,>0202 DATA >834A,>8CB0,>1606,>8CB0 DATA >1604,>8CB0,>1602,>C030 DATA >0450,>0221,>0008,>10EF DATA >0200,>2500,>C800,>8322 DATA >02E0,>83E0,>0460,>00CE DATA >C81D,>8322,>10F9,>C01D DATA >C06D,>0002,>06A0,>20DC DATA >C0C1,>0603,>0223,>8300 DATA >D0D3,>1361,>0983,>0643 DATA >1612,>C000,>165C,>C0C5 DATA >05C3,>06A0,>2406,>1653 DATA >05C3,>06A0,>23CA,>0204 DATA >834A,>0202,>0008,>DC74 DATA >0602,>15FD,>0380,>06A0 DATA >20F8,>10F5,>C041,>1347 DATA >0A81,>9060,>8312,>1143 DATA >0981,>C141,>0A35,>0225 DATA >0008,>A160,>8310,>045B DATA >C24B,>0643,>1634,>C0C5 DATA >06A0,>23CA,>C0C1,>06A0 DATA >2406,>112D,>06A0,>211C DATA >06A0,>23CA,>6004,>0A30 DATA >A040,>0459,>C28B,>0A51 DATA >09D1,>C201,>D120,>8343 DATA >0984,>1303,>0600,>1123 DATA >0580,>0206,>0001,>C0C5 DATA >0223,>0004,>06A0,>23CA DATA >C0C1,>0643,>05C3,>06A0 DATA >23CA,>0581,>6044,>3981 DATA >C186,>1611,>C187,>0608 DATA >15F5,>0606,>A184,>8180 DATA >150A,>05C3,>045A,>0200 DATA >0700,>0460,>2084,>0200 DATA >1C00,>0460,>2084,>0200 DATA >1400,>0460,>2084,>C01D DATA >C06D,>0002,>06A0,>20DC DATA >C0C1,>0603,>0223,>8300 DATA >D0D3,>0983,>160E,>C000 DATA >1622,>0202,>0008,>0204 DATA >834A,>C0C5,>06A0,>23CA DATA >CD01,>05C3,>0642,>15FA DATA >0380,>0643,>160F,>C000 DATA >1612,>C0C5,>05C3,>06A0 DATA >2406,>160B,>05C3,>06A0 DATA >23CA,>C101,>0201,>834A DATA >0460,>20CA,>06A0,>20F8 DATA >10F8,>0460,>2166,>0460 DATA >216E,>C81D,>2038,>C82D DATA >0002,>83E2,>C82D,>0004 DATA >2044,>02E0,>83E0,>C80B DATA >2040,>C020,>2044,>06A0 DATA >20DC,>C0C1,>0603,>0223 DATA >8300,>D0D3,>0983,>0603 DATA >1332,>0643,>164A,>C2A0 DATA >2038,>162D,>C0C5,>05C3 DATA >06A0,>2406,>9801,>2058 DATA >1620,>0206,>0008,>0204 DATA >834A,>C0C5,>06A0,>23CA DATA >CD01,>05C3,>0646,>15FA DATA >06A0,>22DA,>0225,>0004 DATA >C105,>C046,>06A0,>23E6 DATA >05C4,>D050,>0981,>06A0 DATA >23E6,>C2E0,>2040,>C820 DATA >203E,>830C,>02E0,>2038 DATA >0380,>0200,>0700,>C2E0 DATA >2040,>0460,>2084,>0200 DATA >1C00,>0460,>226E,>C08B DATA >0643,>16F3,>C0C5,>06A0 DATA >23CA,>C0C1,>06A0,>2406 DATA >1102,>0460,>226A,>C020 DATA >2038,>06A0,>211C,>6004 DATA >0A10,>A0C0,>06A0,>23CA DATA >0452,>06A0,>227E,>0206 DATA >834A,>CD83,>DDA0,>2058 DATA >DD84,>CD81,>C0C1,>1602 DATA >04D6,>1005,>0603,>06A0 DATA >2406,>0981,>C581,>C020 DATA >2044,>06A0,>22DA,>0460 DATA >225A,>C80B,>203A,>C805 DATA >203C,>C2E0,>601E,>069B DATA >C020,>2044,>C160,>203C DATA >D190,>0986,>C820,>830C DATA >203E,>C806,>830C,>C806 DATA >8350,>C2E0,>6012,>069B DATA >C020,>2044,>0206,>834A DATA >0204,>001C,>CD84,>DDA0 DATA >2058,>DD84,>C5A0,>831C DATA >C0A0,>830C,>1309,>C116 DATA >C0C0,>0583,>D073,>06A0 DATA >241A,>0584,>0602,>15FA DATA >C2E0,>6028,>069B,>C020 DATA >2044,>C160,>203C,>C2E0 DATA >203A,>045B,>C01D,>C06D DATA >0002,>06A0,>20DC,>C0C1 DATA >0603,>0223,>8300,>D0D3 DATA >0983,>0603,>1302,>0643 DATA >1623,>C000,>1628,>C02D DATA >0004,>C0C5,>05C3,>06A0 DATA >2406,>9801,>2058,>161D DATA >05C3,>06A0,>23CA,>C041 DATA >1307,>C181,>0601,>C0C1 DATA >06A0,>2406,>9050,>1A15 DATA >DC01,>1309,>C0C6,>0981 DATA >C141,>06A0,>2406,>DC01 DATA >0583,>0605,>15FA,>0380 DATA >06A0,>227E,>C02D,>0004 DATA >10E6,>0460,>2166,>0460 DATA >216E,>0200,>1300,>0460 DATA >2084,>06C3,>D803,>8C02 DATA >06C3,>D803,>8C02,>1000 DATA >D060,>8800,>06C1,>D060 DATA >8800,>06C1,>045B,>06C4 DATA >D804,>8C02,>06C4,>0264 DATA >4000,>D804,>8C02,>1000 DATA >D801,>8C00,>06C1,>D801 DATA >8C00,>06C1,>045B,>06C3 DATA >D803,>8C02,>06C3,>D803 DATA >8C02,>1000,>D060,>8800 DATA >045B,>06C4,>D804,>8C02 DATA >06C4,>0264,>4000,>D804 DATA >8C02,>1000,>D801,>8C00 DATA >045B,>C83E,>83E2,>02E0 DATA >83E0,>C80B,>204E,>C081 DATA >0281,>0040,>1B0A,>C0A1 DATA >6010,>0281,>0004,>1605 DATA >C0A2,>0002,>0692,>2466 DATA >1001,>0692,>02E0,>2038 DATA >C80B,>83F6,>0380,>0200 DATA >0B00,>0460,>2084,>02E0 DATA >83E0,>C80B,>204E,>06A0 DATA >000E,>02E0,>2038,>C80B DATA >83F6,>0380,>06A0,>24CA DATA >D82D,>0002,>8C00,>0380 DATA >06A0,>24CA,>D831,>8C00 DATA >0602,>16FC,>0380,>06A0 DATA >24D0,>DB60,>8800,>0002 DATA >0380,>06A0,>24D0,>DC60 DATA >8800,>0602,>16FC,>0380 DATA >C05D,>D82D,>0001,>8C02 DATA >0261,>8000,>D801,>8C02 DATA >0380,>0201,>4000,>1001 DATA >04C1,>C09D,>D820,>203D DATA >8C02,>E081,>D802,>8C02 DATA >C06D,>0002,>C0AD,>0004 DATA >045B *********************************************************** CHARS BYTE >00,>00,>00,>00,>00,>00,>00 * 32 BYTE >20,>20,>20,>20,>20,>00,>20 * 33 BYTE >50,>50,>50,>00,>00,>00,>00 * 34 BYTE >50,>50,>F8,>50,>F8,>50,>50 * 35 BYTE >20,>78,>A0,>70,>28,>F0,>20 * 36 BYTE >C0,>C8,>10,>20,>40,>98,>18 * 37 BYTE >40,>A0,>A0,>40,>A8,>90,>68 * 38 BYTE >C0,>40,>80,>00,>00,>00,>00 * 39 BYTE >08,>10,>20,>20,>20,>10,>08 * 40 BYTE >80,>40,>20,>20,>20,>40,>80 * 41 BYTE >20,>A8,>70,>D8,>70,>A8,>20 * 42 BYTE >00,>20,>20,>F8,>20,>20,>00 * 43 BYTE >00,>00,>00,>00,>60,>20,>40 * 44 BYTE >00,>00,>00,>F8,>00,>00,>00 * 45 BYTE >00,>00,>00,>00,>00,>60,>60 * 46 BYTE >00,>08,>10,>20,>40,>80,>00 * 47 BYTE >70,>88,>98,>A8,>C8,>88,>70 * 48 BYTE >20,>60,>20,>20,>20,>20,>70 * 49 BYTE >70,>88,>08,>30,>40,>80,>F8 * 50 BYTE >70,>88,>08,>30,>08,>88,>70 * 51 BYTE >10,>30,>50,>90,>F8,>10,>10 * 52 BYTE >F0,>80,>80,>F0,>08,>88,>70 * 53 BYTE >70,>80,>80,>F0,>88,>88,>70 * 54 BYTE >F8,>08,>10,>20,>40,>40,>40 * 55 BYTE >70,>88,>88,>70,>88,>88,>70 * 56 BYTE >70,>88,>88,>78,>08,>88,>70 * 57 BYTE >00,>60,>60,>00,>60,>60,>00 * 58 BYTE >00,>60,>60,>00,>60,>20,>40 * 59 BYTE >08,>10,>20,>40,>20,>10,>08 * 60 BYTE >00,>00,>F8,>00,>F8,>00,>00 * 61 BYTE >80,>40,>20,>10,>20,>40,>80 * 62 BYTE >70,>88,>10,>20,>20,>00,>20 * 63 BYTE >70,>88,>08,>68,>A8,>A8,>58 * 64 BYTE >70,>88,>88,>F8,>88,>88,>88 * 65 BYTE >F0,>48,>48,>70,>48,>48,>F0 * 66 BYTE >70,>88,>80,>80,>80,>88,>70 * 67 BYTE >F0,>48,>48,>48,>48,>48,>F0 * 68 BYTE >F8,>80,>80,>F0,>80,>80,>F8 * 69 BYTE >F8,>80,>80,>F0,>80,>80,>80 * 70 BYTE >70,>88,>80,>80,>98,>88,>78 * 71 BYTE >88,>88,>88,>F8,>88,>88,>88 * 72 BYTE >F8,>20,>20,>20,>20,>20,>F8 * 73 BYTE >08,>08,>08,>08,>08,>88,>70 * 74 BYTE >88,>90,>A0,>C0,>A0,>90,>88 * 75 BYTE >80,>80,>80,>80,>80,>80,>F8 * 76 BYTE >88,>D8,>A8,>A8,>88,>88,>88 * 77 BYTE >88,>88,>C8,>A8,>98,>88,>88 * 78 BYTE >70,>88,>88,>88,>88,>88,>70 * 79 BYTE >F0,>88,>88,>88,>F0,>80,>80 * 80 BYTE >70,>88,>88,>88,>A8,>90,>68 * 81 BYTE >F0,>88,>88,>F0,>A0,>90,>88 * 82 BYTE >70,>88,>80,>70,>08,>88,>70 * 83 BYTE >F8,>20,>20,>20,>20,>20,>20 * 84 BYTE >88,>88,>88,>88,>88,>88,>70 * 85 BYTE >88,>88,>88,>88,>88,>50,>20 * 86 BYTE >88,>88,>88,>88,>A8,>A8,>50 * 87 BYTE >88,>88,>50,>20,>50,>88,>88 * 88 BYTE >88,>88,>88,>50,>20,>20,>20 * 89 BYTE >F8,>08,>10,>20,>40,>80,>F8 * 90 BYTE >78,>40,>40,>40,>40,>40,>78 * 91 BYTE >00,>80,>40,>20,>10,>08,>00 * 92 BYTE >F0,>10,>10,>10,>10,>10,>F0 * 93 BYTE >20,>50,>88,>00,>00,>00,>00 * 94 BYTE >00,>00,>00,>00,>00,>00,>FF * 95 BYTE >18,>10,>08,>00,>00,>00,>00 * 96 BYTE >00,>00,>60,>10,>70,>90,>68 * 97 BYTE >00,>40,>40,>70,>48,>48,>B0 * 98 BYTE >00,>00,>60,>90,>80,>90,>60 * 99 BYTE >00,>10,>10,>70,>90,>90,>68 * 100 BYTE >00,>00,>60,>90,>E0,>80,>70 * 101 BYTE >00,>30,>40,>E0,>40,>40,>40 * 102 BYTE >00,>00,>70,>90,>70,>10,>60 * 103 BYTE >00,>80,>80,>E0,>90,>90,>90 * 104 BYTE >00,>20,>00,>20,>20,>20,>70 * 105 BYTE >00,>10,>00,>10,>10,>90,>60 * 106 BYTE >00,>80,>90,>A0,>C0,>A0,>90 * 107 BYTE >00,>60,>20,>20,>20,>20,>70 * 108 BYTE >00,>00,>D0,>A8,>A8,>A8,>A8 * 109 BYTE >00,>00,>B0,>48,>48,>48,>48 * 110 BYTE >00,>00,>60,>90,>90,>90,>60 * 111 BYTE >00,>00,>F0,>48,>48,>70,>40 * 112 BYTE >00,>00,>78,>90,>90,>70,>10 * 113 BYTE >00,>00,>B0,>C8,>80,>80,>80 * 114 BYTE >00,>00,>70,>80,>70,>08,>F0 * 115 BYTE >00,>40,>E0,>40,>40,>50,>20 * 116 BYTE >00,>00,>90,>90,>90,>90,>68 * 117 BYTE >00,>00,>88,>88,>88,>50,>20 * 118 BYTE >00,>00,>88,>88,>A8,>A8,>50 * 119 BYTE >00,>00,>88,>50,>20,>50,>88 * 120 BYTE >00,>00,>48,>48,>38,>08,>70 * 121 BYTE >00,>00,>F8,>10,>20,>40,>F8 * 122 BYTE >18,>20,>20,>40,>20,>20,>18 * 123 BYTE >20,>20,>20,>00,>20,>20,>20 * 124 BYTE >C0,>20,>20,>10,>20,>20,>C0 * 125 BYTE >00,>00,>40,>A8,>10,>00,>00 * 126 BYTE >00,>00,>00,>00,>00,>00,>00 * 127 BYTE >00,>00,>00,>00,>00,>00,>00 * 128 *********************************************************** END Spoiler *********************************************************** TITL 'MYXB5' *********************************************************** GROM >A000 *********************************************************** TITL 'EQUATES EXEC-359' *********************************************************** * GROM ADDRESSES *********************************************************** * EQUATES FOR ROUTINES FROM OTHER GROM SECTIONS CHRTBL EQU >6018 RXB CALL CHRTBL load char set TOPLEV EQU >6372 RXB CALL USER branch SZNEW EQU >63A5 RXB CALL NEW branch TOPL15 EQU >63DD RXB CALL USER branch SZSIZE EQU >65C9 RXB CALL SIZE branch CLSALL EQU >8012 RXB branch GE025 EQU >E025 RXB branch EA module SPRINT EQU >6016 Initialize sprites TOPL10 EQU >601A Return to main and re-init CHRTAB EQU >601C Load default character set SZRUN EQU >601E KILSYM EQU >6022 KILL SYMBOL TABLE ROUTINE AUTO1 EQU >602E Get arguments for LIST comman TOPL02 EQU >6030 RTN address for failing AUTOL EDITLN EQU >6032 Edit a line into the program GRSUB1 EQU >6034 Read data (2 bytes) from ERAM GWSUB EQU >6036 Write a few bytes of data to MSGBRK EQU >6048 * BREAKPOINT MSGTA EQU >6053 Message "try again" CHKEND EQU >6A78 Check end of statement DISO EQU >6A7C ENTER EQU >6A7E ENT09 EQU >6A80 WARNZZ EQU >6A82 WARNING MESSAGE ROUTINE ERRZZ EQU >6A84 ERROR MESSAGE ROUTINE ERRZ EQU >6A84 ERRor routine READL1 EQU >6A86 Read a line from keyboard DISPL1 EQU >8000 DELET EQU >8002 PRINT EQU >8004 INPUT EQU >8006 OPEN EQU >8008 CLOSE EQU >800A RESTOR EQU >800C NREAD EQU >800E EOF EQU >801C ACCEPT EQU >801E SRDATA EQU >8020 REC EQU >8022 GRSUB2 EQU >802C GRSUB3 EQU >802E LINPUT EQU >8030 GRINT EQU >0022 Greatest integer *********************************************************** * Equates for XMLs SYNCHK EQU >00 SYNCHK XML selector FILSPC EQU >01 Fill-space utility PARCOM EQU >01 PARse to a COMma selector CSTRIN EQU >02 Copy-string utility RANGE EQU >02 RANGE selector SEETWO EQU >03 SEETWO XML selector FADD EQU >06 Floating ADD FMUL EQU >08 Floating MULtiply FDIV EQU >09 Floating DIVide FCOMP EQU >0A Floating COMPare SADD EQU >0B Stack ADD SSUB EQU >0C Stack SUBtract CSNUM EQU >10 Convert String to Number CFI EQU >12 Convert to two byte integer FLTINT EQU >12 Convert floating to integer COMPCT EQU >70 PREFORM A GARBAGE COLLECTION GETSTR EQU >71 SYSTEM GET STRING MEMCHK EQU >72 MEMORY check routine: VDP CNS EQU >73 Convert number to string * Warning Defualt changfd in >0079 PARSE EQU >74 Parse a value CONT EQU >75 Continue parsing EXECG EQU >76 Execute a XB stmt or program 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 SCHSYM EQU >7D Search symbol table SPEED EQU >7E SPEED UP XML CRUNCH EQU >7F Crunch an input line CIF EQU >80 Convert INTEGER to FLOATING P RTNB EQU >82 Return SCROLL EQU >83 SCROLL THE SCREEN IO EQU >84 IO utility (KW table search) GREAD EQU >85 READ DATA FROM ERAM GWRITE EQU >86 WRITE DATA TO ERAM DELREP EQU >87 REMOVE CONTENT FROM VDP/ERAM MVDN EQU >88 MOVE DATA IN VDP/ERAM MVUP EQU >89 MOVE DATA IN VDP/ERAM VGWITE EQU >8A MOVE DATA FROM VDP TO ERAM GVWITE EQU >8B WRITE DATA FROM GRAM TO VRAM GREAD1 EQU >8C READ DATA FROM ERAM GDTECT EQU >8E ERAM DETECT&ROM PAGE 1 ENABLE SCNSMT EQU >8F SCAN STATEMENT FOR PRESCAN *********************************************************** * Temporary workspaces in EDIT VAR0 EQU >8300 TEMPORARY SP00 EQU >8300 SPRITE value PTFBSL EQU >8300 Ptr to 1st byte in SPEAK list PHLEN EQU >8300 PHrom data LENgth VARV EQU >8301 TEMPORARY PHRADD EQU >8301 PHRom ADDress ACCUM EQU >8302 # OF BYTES ACCUMULATOR (4 BYTE STPT EQU >8302 TWO BYTES MNUM EQU >8302 Ussually a counter AAA1 EQU >8302 SP02 EQU >8302 SPRITE value PTLBSL EQU >8302 Ptr to last byte in SPEAK list VARY EQU >8304 PABPTR EQU >8304 Pointer to current PAB SP04 EQU >8304 SPRITE value PTEBSL EQU >8304 Ptr to end byte in SPEAK list * NOTE: PTEBSL points to the end of the temporary speak lis * whereas PTLBSL points to the last byte actually use * i.e. PTFBSL <= PTLBSL <= PTEBSL VARY2 EQU >8306 Use in MVDN only DFLTLM EQU >8306 Default array limit (10) CCPPTR EQU >8306 OFFSET WITHIN RECORED (1) * or Pointer to current column SP06 EQU >8306 SPRITE value PTFCIS EQU >8306 Ptr to 1st character in string RECLEN EQU >8307 LENGTH OF CURRENT RECORD (1) CCPADR EQU >8308 RAM address of current refs * or Actual buffer address or c VARC EQU >8308 CCPADD EQU >8308 RAM address of current color CCC1 EQU >8308 SPSAL EQU >8308 Location of sprite attribute l PTCCIS EQU >8308 Ptr to current character in st CALIST EQU >830A Call list for resolving refs RAMPTR EQU >830A Pointer for crunching STADDR EQU >830A Start address - usually for co SPTMP EQU >830A Temporary variable PTLCIS EQU >830A Ptr to last character in strin VAR2 EQU >830B BYTES EQU >830C BYTE COUNTER * or String length for GETSTR NMPTR EQU >830C Pointer save for pscan BBB1 EQU >830C PTFCIP EQU >830C Ptr to 1st character in phrase CHSAV EQU >830E CURINC EQU >830E Increment for auto-num mode VAR4 EQU >830E PTCCIP EQU >830E Ptr to current character in ph TOPSTK EQU >8310 Top of data stack pointer VAR5 EQU >8310 VAR5 through VAR5+3 used in RA PTLCIP EQU >8310 Ptr to last character in phras VAR6 EQU >8311 LINUM EQU >8312 Used to determine end of scan PTFBPH EQU >8312 Ptr to 1st byte in PHrom VAR7 EQU >8312 Used in CHARLY STRPTR EQU >8312 RXB PATCH CODE NMLEN EQU >8314 Current line for auto-num CURLIN EQU >8314 Current line for auto-num * or Starting line number for L PTCCPH EQU >8314 Ptr to current byte in PHrom VAR9 EQU >8314 Used in CHARLY XFLAG EQU >8316 SCAN FLAG-BITS USED AS BELOW PTLCPH EQU >8316 Ptr to last byte in PHrom DSRFLG EQU >8317 INTERNAL =60, EXTERNAL =0 (1) OPTFLG EQU >8317 Option flag byte during OPEN FORNET EQU >8317 Nesting level of for/next FNUM EQU >8317 Current file number for search *********************************************************** * Permanent workspace variables STRSP EQU >8318 String space begining STREND EQU >831A String space ending SREF EQU >831C Temporary string pointer SMTSRT EQU >831E Start of current statement VARW EQU >8320 Screen address (CURSOR) ERRCOD EQU >8322 Return error code from ALC STVSPT EQU >8324 Value-stack base RTNG EQU >8326 Return vector from 9900 code NUDTAB EQU >8328 Start of NUD table 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 DATA EQU >8334 Data pointer for READ LNBUF EQU >8336 Line table pointer for READ INTRIN EQU >8338 Add of intrinsic poly constant SUBTAB EQU >833A Subprogram symbol table IOSTRT EQU >833C PAB list/Start of I/O chain SYMTAB EQU >833E Symbol table pointer FREPTR EQU >8340 Free space pointer CHAT EQU >8342 Current charater/token BASE EQU >8343 OPTION BASE value PRGFLG EQU >8344 Program/imperative flag FLAG EQU >8345 General 8-bit flag BUFLEV EQU >8346 Crunch-buffer destruction leve LSUBP EQU >8348 Last subprogram block on stack * FAC EQU >834A Floating-point ACcurmulator CCHAR EQU >834A Current character FAC1 EQU FAC+1 SPLFLG EQU >834B SPelL out phrase FLaG FAC2 EQU FAC+2 AAA EQU FAC+2 TOTTIM EQU >834C TOTal wait TIMe * NOTE: DATAD must follow immediately after TOTTIM. The * routine STDATA is counting on this fact! FAC3 EQU FAC+3 DATAAD EQU >834D Speech DATA ADdress FAC4 EQU FAC+4 CCC EQU FAC+4 FFF EQU FAC+4 FAC5 EQU FAC+5 PTLCIL EQU >834F Pointer To Last Character In L FAC6 EQU FAC+6 BBB EQU FAC+6 EEE EQU FAC+6 FAC7 EQU FAC+7 TIMLEN EQU >8351 TIMe LENgth of timing charact FAC8 EQU FAC+8 PHADDR EQU >8352 PHrom ADDRess FAC9 EQU FAC+9 FAC10 EQU FAC+10 DDD1 EQU FAC+10 TEMP1 EQU >8354 TEMPorary CPU location 1 FAC11 EQU FAC+11 FAC12 EQU FAC+12 FFF1 EQU FAC+12 TEMP2 EQU >8356 TEMPorary CPU location 2 FAC13 EQU FAC+13 FAC14 EQU FAC+14 EEE1 EQU FAC+14 READ EQU >8358 Address of speech peripheral * READ byte interface FAC15 EQU FAC+15 FAC16 EQU FAC+16 WRITE EQU >835A Address of speech peripheral * WRITE byte interface FAC17 EQU FAC+17 * ARG EQU >835C Floating-point ARGument ARG1 EQU ARG+1 PHDATA EQU >835D PHrom DATA ARG2 EQU ARG+2 PTCBED EQU >835E Ptr To Current Byte Ext Data ARG3 EQU ARG+3 ARG4 EQU ARG+4 LENCST EQU >8360 LEN of Current ext data STring ARG5 EQU ARG+5 ARG6 EQU ARG+6 LENWST EQU >8362 LEN of Whole ext data STring ARG7 EQU ARG+7 ARG8 EQU ARG+8 STRLEN EQU >8364 STRing LENgth TEMP4 EQU >8364 TEMP5 EQU >8366 * NOTE: BYTE1, BYTE2, and BYTE3 must be in consecutive memo * locations, and in the following order for SPGET to * work! BYTE1 EQU >8366 BYTE 1 BYTE2 EQU >8367 BYTE 2 BYTE3 EQU >8368 BYTE 3 TEMP6 EQU >8368 SPKSTS EQU >8369 SPeaK StaTus * FPERAD EQU >836C Value stack pointer ARG11 EQU ARG+11 ARG15 EQU ARG+15 ARG16 EQU ARG+16 * VSPTR EQU >836E Value stack pointer *********************************************************** * GPL Status Block * SUBSTK EQU >8373 SUBROUTINE STACK KEYBD EQU >8374 KEYBOARD SELCTION RKEY EQU >8375 KEY CODE EXPZ EQU >8376 Exponent in floating-point JOYY EQU >8376 JOYSTICK Y POSITION JOYX EQU >8377 JOYSTICK X POSITION RANDOM EQU >8378 RANDOM NUMBER GENERATOR TIMER EQU >8379 TIMING REGISTER MOTION EQU >837A NUMBER OF MOVING SPRITES VDPSTS EQU >837B VDP STATUS REGISTER VDPSTT EQU >837B VDP STATUS REGISTER ERCODE EQU >837C STATUS REGISTER CB EQU >837D Character Buffer *********************************************************** RAMTOP EQU >8384 Highest address in ERAM RAMFRE EQU >8386 Free pointer in the ERAM RSTK EQU >8388 Subroutine stack base * (Starts at >8A) RAMFLG EQU >8389 ERAM flag GRAMFL EQU >8389 GRAM / VDP flag STKMIN EQU >83AF Base of data stack STKMAX EQU >83BD Top of data stack PRTNFN EQU >83CE Sound - previous tone finished *********************************************************** * VDP addresses SCRNBS EQU >02E0 Screen base addr for last lin NLNADD EQU >02E2 New LiNe ADDress ENDSCR EQU >02FE END of SCReen address SPRSAL EQU >0300 Sprite attribute list START EQU >0372 Line to start execution at * Temporary NOTONE EQU >0374 NO-TONE for SIZE in ACCEPT us * in FLMGRS (4 bytes used) SYMBOL EQU >0376 Saved symbol table pointer ONECHR EQU >0378 Used for CHRZ VRMSND EQU >0379 Sound blocks SPGMPT EQU >0382 Saved PGMPTR for continue SBUFLV EQU >0384 Saved BUFLEV for contiue SEXTRM EQU >0386 Saved EXTRAM for continue SAVEVP EQU >0388 Saved VSPRT for continue ERRLN EQU >038A On-error line pointer CSNTMP EQU >0390 Use as temporary stored place * or CSN TEMPORARY FOR FAC12 TABSAV EQU >0392 Saved main symbol table ponte AUTTMP EQU >0394 AUTOLD TEMPORARY IN SIDE ERRZ SLSUBP EQU >0396 Saved LSUBP for continue SFLAG EQU >0398 Saved on-warning/break bits SSTEMP EQU >039A To save subprogram program ta SSTMP2 EQU >039C Same as above. Used in SUBPRO MRGPAB EQU >039E MERGEd temporary for pab ptr RNDX2 EQU >03A0 Random number generator seed RNDX1 EQU >03A5 Random number generator seed INPUTP EQU >03AA INPUT TEMPORARY FOR PTR TO PR SPNUM EQU >03AA Sprite number temporary, also * in INPUTP in FLMGR ACCVRW EQU >03AC Temoporary used in ERRZZ, als * used in FLMGRS * or temporary for @VARW, @VARA ACCVRA EQU >03AE TRY AGAIN VALIDP EQU >03B0 Use as two values passing fro * or PTR TO STANDARD STRING IN VAL VALIDL EQU >03B2 VALIDATE code to READL1 * or Length of string in validate SIZCCP EQU >03B4 SIZE TEMPORARY FOR CCPADR SIZREC EQU >03B6 SIZE TEMPORARY FOR RECLEN * ACCTRY EQU >03B7 ACCEPT "TRY AGAIN" FLAG SIZXPT EQU >03B8 Save XPT in SIZE when "try ag CSNTP1 EQU >03BA CSN TEMPORARY FOR FAC10 * OLDTOP EQU >03BC Temporary used in ERRZZ, also * or Old top of memory for RELOCA CPTEMP EQU >03BC CCPPTR, RECLEN temp in INPUT NEWTOP EQU >03BE New top of memory for RELOCA VROAZ EQU >03C0 Temporary roll-out area SPRVB EQU >07FF Sprite velocity block. CRNBUF EQU >0820 CRuNch BUFfer address CRNEND EQU >08BE CRuNch buffer END VRAMVS EQU >0958 Default base of value stack *********************************************************** * IMMEDITATE VALUES NUMBR EQU >00 NUMERIC validate LISTZ EQU >02 X2 EQU >03 OLDZ EQU >05 RESEQZ EQU >06 SAVEZ EQU >07 MERGEZ EQU >08 DWNARR EQU >0A UPARR EQU >0B CHRTN EQU >0D BKGD EQU >20 BACKGROUND CHARACTER OFFSET EQU >60 OFFSET FOR VIDEO TABLES STRVAL EQU >65 Value in accum. is string val *********************************************************** * Editting command equates & keys or symbols BREAK EQU >02 Break key DLETE EQU >03 Delete key INSRT EQU >04 Insert key RECALL EQU >06 Edit-buffer recall CLRLN EQU >07 Clear-line key BACK EQU >08 Back-space key FORW EQU >09 Forward-space key DOWN EQU >0A Down-arrow key UPMV EQU >0B Up-arrow key VWIDTH EQU >1C Screen width (PRINT) SPACE EQU >20 Space key QUOTE EQU >22 " NUMBER EQU >23 # DOLLAR EQU >24 $ CURSOR EQU >1E+OFFSET CURSOR EDGECH EQU >1F+OFFSET EDGE character PLUS EQU >2B + COMMAT EQU >2C , MINUS EQU >2D - HYPEN EQU >2D + PERIOD EQU >2E . ZERO EQU >30 0 NINE EQU >39 9 COLON EQU >3A : SEMICO EQU >3B ; LESS EQU >3C < GREAT EQU >3E > A EQU >41 A F EQU >46 F *********************************************************** * 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 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 * EQU >CA spare token 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 VAL 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 >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 *********************************************************** * NOTE: FILES EXECSD, SUBS AND PART OF PSCANS ARE IN GROM 5 * AS BELOW: *-------NAME------------------ADDRESS---------BYTES LEFT--- * EXECS >A000 - >AD92 5 * SUBS >AD98 - >B4DC 2 * PSCANS >B4E0 - >B7FA 5 * * Some of the error calls at the end of EXECS file are * shared and directly addressed by SUBS file. Any change in * EXECS file which affects the address of error calls will * affect error reference in SUBS file. Make sure to edit * SUBS file in that situation. *********************************************************** XML CONT XML CONT used by subprogram BR LITS05 Build FAC entry and GETSTR BR EXEC Execute a program BR LINE BR DATAST BR ASC BR EXEC1 BR EXEC6D Save information on a break BR DELINK Delink symbol table entry BR CONV1 BR SQUISH Called in error routine in PS BR VALCD BR INTRND BR $ GA01C BR LNKRTN Routine to go back to XB prog GA01E BR SPCOL Clear breakpoint in line # ro BR UBSUB Spare BR $ BR $ *** Please let me know it you add * *** branches here since it will a * *** the address of link list. Sum LINK1 DATA LINK2 STRI 'SOUND' DATA SOUND LINK2 DATA LINK3 STRI 'CLEAR' DATA CLEAR LINK3 DATA LINK4 STRI 'COLOR' DATA COLOR LINK4 DATA LINK5 STRI 'GCHAR' DATA GCHAR LINK5 DATA LINK6 STRI 'HCHAR' DATA HCHAR LINK6 DATA LINK7 STRI 'VCHAR' DATA VCHAR LINK7 DATA LINKA STRI 'CHAR' DATA CHARLY LINKA DATA LINKB STRI 'KEY' DATA ZKEY LINKB DATA LINKC STRI 'JOYST' DATA ZJOYST LINKC DATA LINKD STRI 'SCREEN' DATA BORDER LINKD DATA LINKE STRI 'VERSION' DATA VERS LINKE DATA LINKS1 STRI 'ERR' DATA ERRWXY *********************************************************** * START EXECUTION OF A PROGRAM OR STATEMENT * DATA: * RAM(START) points into line number table at the * first line to execute * @PGMFLG contains >FF if executing a program or zero * if imperative statement *********************************************************** EXEC CZ @PRGFLG If program BS GA0AE DST V@START,@EXTRAM Line to start execution at DINCT @EXTRAM Pointer to text pointer CALL INTRND Initialize random number EXEC1 ST X2,@XPT Initialize screen display BR GA0B2 GA0AE DST CRNBUF,@PGMPTR Executing out of crunch buffe GA0B2 DST EXEC20,@RTNG Address of return from ALC DST NUDTB,@NUDTAB NUD table address for ALC XML EXECG Execute XB EXEC20 CASE @ERRCOD+1 Check type of return BR EXECND 0 - NORMAL END BR EXECBK 1 - BREAKPOINT BR EXECTR 2 - TRACE BR ERORZ 3 - ERROR BR WARNGZ 4 - WARNING BR ONERR 5 - ON ERROR BR UDF 6 - FUNCTION BR ONBRK 7 - ON BREAK BR CONCAT 8 - CONCATENATE STRINGS "&" BR ONWARN 9 - ON WARNING BR GPLCAL A - CALL STATEMENT WARNGZ CH >B0,@SUBSTK BS ERRSO * Stack overflow * ALLOW ROOM ON STACK FOR WARNING CALLS WRNN01 CALL WARNZZ ONLY WARNING MSG FROM XB SUPPORT BYTE 2 * NUMERIC OVERFLOW BR CLRRTN Clear ERRCOD and return * NORMAL END OF EXECUTION EXECND CZ @PRGFLG If imperative mode BR ERRRDY CALL CHRTAB Load the default character se B TOPL15 Return to top-level ERRRDY CALL ERRZZ Display * READY * BYTE 0 * TRACE-MODE turned on - display line number EXECTR CLR @VARW Clear upper address byte ST @XPT,@VARW+1 Get current x-pointer DADD NLNADD-3,@VARW Make a valid screen address DCH NLNADD+22,@VARW If might go off screen BR GA102 XML SCROLL SCROLL to next line DST NLNADD,@VARW Re-initialize screen address GA102 ST LESS+OFFSET,V*VARW Display open bracket "(" DINC @VARW Increment screen address CALL ASC Convert line # into ASCII ST GREAT+OFFSET,V*VARW Display close bracket ")" DSUB NLNADD-4,@VARW Update the x-pointer ST @VARW+1,@XPT CLRRTN DCLR @ERRCOD Clear the return vector XML RTNB Return to ALC * BREAKPOINT OR BREAK-KEY RECIEVED EXECBK CZ @PRGFLG If break or program BS ERRBRK DST @EXTRAM,@FAC8 @FAC8 : Source addr in ERAM DDECT @FAC8 Point to the line # CALL UBSUB1 Reset the breakpoint SCAN Get break key out of queue EXEC6C DST @PGMPTR,V@SPGMPT Save text pointer EXEC6D DST @EXTRAM,V@SEXTRM Save line number table pointe DST @VSPTR,V@SAVEVP Save value stack pointer DST @BUFLEV,V@SBUFLV Save crunch buffer level DST @LSUBP,V@SLSUBP Save last subprogram on stack ST @FLAG,V@SFLAG Save FLAG for continue AND >63,V@SFLAG Only warning and break bits ERRBRK CALL ERRZZ * BREAKPOINT BYTE 1 *********************************************************** * NUD / STATEMENT BRANCH TABLE *********************************************************** NUDTB BR RECX 'RECORD' 0 BR NBREAK 'BREAK' 0 BR NUNBRK 'UNBREAK' 0 BR NTRACE 'TRACE' 0 BR NUNTRC 'UNTRACE' 0 BR NREADX 'READ' 0 BR PRINTX 'PRINT' 0 BR SZRUNX 'RUN' 0 BR LINPUX Reserved for LINPUT 1 BR RESTOX 'RESTORE' 1 BR NRNDMZ 'RANDOMIZE' 1 BR INPUTX 'INPUT' 1 BR OPENX 'OPEN' 1 BR CLOSEX 'CLOSE' 1 BR NPI 'PI' 1 BR NMAX 'MAX' 1 BR NMIN 'MIN' 2 BR RPTZ01 'RPT$' 2 BR ACCEPX 'ACCEPT' 2 BR EOFX 'EOF' 2 BR ASC01 'ASC' 2 BR POS01 'POS' 2 BR VAL01 'VAL' 2 BR STRZ01 'STR$' 2 BR SEGZ01 'SEG$' 3 BR DELETX 'DELETE' 3 BR DISPLX 'DISPLAY' 3 BR LEN01 'LEN' 3 BR CHRZ01 'CHR$' 3 BR NRND 'RND' 3 * The following are long branches to another GROM EOFX B EOF SZRUNX B SZRUN RECX B REC NREADX B NREAD PRINTX B PRINT RESTOX B RESTOR INPUTX B INPUT OPENX B OPEN CLOSEX B CLOSE ACCEPX B ACCEPT DISPLX B DISPL1 DELETX B DELET LINPUX B LINPUT *********************************************************** * FLAGS USED IN EXECUTION MODE: this needs to be checked * @FLAG BIT RESET SET * 0 * 1 Warning PRINT PRINT off * 2 Warning NEXT STOP * 3 Not in UDF Executing a UDF * 4 TRACE mode Normal mode * 5 * 6 BREAK allowed BREAK not allowed * 7 No LST/EDT protect LIST/EDIT protected *********************************************************** * ON WARNING {NEXT | STOP | PRINT} * ON WARNING NEXT - Causes warning messages to be ignored * and execution to continue as if a * warning never occurred * ON WARNING STOP - Causes a warning to be treated as an * error - i.e. the message is displayed * and execution is halted * ON WARNING PRINT - Causes the default warning handling to * be in effect, i.e. any warning * messages are printed and execution * continues *********************************************************** ONWARN XML PGMCHR GET OPTION CEQ PRINTZ,@CHAT If print BR GA1B7 AND >F9,@FLAG Turn on print and contiue B ONWRN5 GA1B7 CEQ STOPZ,@CHAT BR GA1C4 AND >FD,@FLAG Turn on print OR >04,@FLAG Turn on stop BR ONWRN5 GA1C4 CEQ NEXTZ,@CHAT * SYNTAX ERROR BR ERRSYN OR >02,@FLAG Turn off print AND >FB,@FLAG Turn off stop ONWRN5 XML PGMCHR Check for EOS ONWRN7 CALL CHKEND Error if not EOS BR ERRSYN If not EOS DCLR @ERRCOD XML CONT Continue *********************************************************** * ON ERROR {line number | STOP} * ON ERROR line number - causes the error routine to build * an error stack entry and pass * control to the line specified in * the most-recently executed * on-error-statement * ON ERROR STOP - causes the default error handling * conditions to be in effect. i.e. any * errors that occur cause execution to halt * an a message to be displayed *********************************************************** ONERR XML PGMCHR Get option CEQ LNZ,@CHAT If line # then find the line BR GA20E XML PGMCHR Get upper byte ST @CHAT,@FAC XML PGMCHR Get lower byte ST @CHAT,@FAC1 DST @ENLN,@FAC2 DSUB 3,@FAC2 Pointing to 1st line # * Consider both ERAM and RAM cases to get line # from the * line number table. Also reset the break bit. ONERR2 CALL GRSUB3 Get 2 bytes from either RAM/E BYTE FAC2 * FAC2 has the address DCEQ @EEE1,@FAC If found BS ONERR4 DCH @STLN,@FAC2 Not found BR ERRLNF DSUB 4,@FAC2 Goto next line BR ONERR2 ONERR4 DINCT @FAC2 DST @FAC2,V@ERRLN BR GA216 GA20E CEQ STOPZ,@CHAT * SYNTAX ERROR BR ERRSYN DCLR V@ERRLN Back to default error handlin GA216 BR ONWRN5 Finish up same as ON WARNING *********************************************************** * ON BREAK {NEXT | STOP} * ON BREAK NEXT - Causes any breakpoints which have been * set on statements to be ignored when the * statement is encountered and also masks * the shift-C key so that it is ignored * ON BREAK STOP - Causes the default break handling to be * in force., i.e. execution is halted and * the BREAKPOINT message is displayed on * the screen *********************************************************** ONBRK XML PGMCHR Get next char to find option CEQ STOPZ,@CHAT If stop option specified BR GA225 AND >BF,@FLAG break allowed B GA22D Don't change this to BR GA22D GA225 CEQ NEXTZ,@CHAT If next option number BR ERRSYN specified then syntax error OR >40,@FLAG If next option specified then * break NOT allowed GA22D BR ONWRN5 Finish up same as ON WARNING *********************************************************** * GPLCAL - If a call is made to a subprogram that does not * not exist either in the BASIC program itself or in the * internal GPL subprogram list then one final attempt is * made to find the subprogram at execution time by * searching for the subprogram in the console or a * peripheral. If not found there, then a * *SUBPROGRAM NOT FOUND error occurs * * Input: the subprogram name is in the FAC and the length * of the name is in FAC15 *********************************************************** GPLCAL CZ @RAMFLG Can't try if CPU program BR ERRSNF DSRL 8,@FAC15 Make name length a double DSUB @FAC15,@PGMPTR Point back at name DDEC @PGMPTR Point at name length DST @PGMPTR,@FAC12 Set pointer to name CALL LINK Issue 'Call Program Link' BYTE 10 * Search subprogram lists BR ONWRN7 If all ok, check-end and rtn BR ERRSNF If not found, error *********************************************************** * NUD FOR PI *********************************************************** NPI MOVE 8,G@CONPI,@FAC Load constant PI XML CONT CONPI BYTE >40,3,14,15,92,65,35,90 * 3.1415992653590E+00 *********************************************************** * NUD FOR MAX *********************************************************** NMAX CALL MAXMIN Combine MAX and MIN GT BR GA263 NMAXZ1 MOVE 8,@ARG,@FAC GA263 XML CONT *********************************************************** * NUD FOR MIN *********************************************************** NMIN CALL MAXMIN Combine MAX and MIN again GT BR NMAXZ1 XML CONT *********************************************************** * COMMON MAX / MIN ROUTINE *********************************************************** MAXMIN CALL LPAR Skip "(" parse, and insure , CH >63,@FAC2 Must be numeric BS ERRSNM XML VPUSH Push l.h. arg on stack XML PARSE PARSE up to ")" BYTE RPARZ CH >63,@FAC2 Must be numeric BS ERRSNM XML SPEED Must be BYTE SYNCHK * at a BYTE RPARZ * right parenthesis MOVE 8,@FAC,@ARG Save in ARG for compare XML VPOP Get l.h. arg back XML FCOMP Compare operands RTN * Initialize random number generator INTRND MOVE 10,G@X2SEED,V@RNDX2 RTN X2SEED BYTE >42,>03,>23,>15,>00 * = 33521, X2 INITIAL VAL X1SEED BYTE >43,>02,>3E,>2A,>17 * = 2624223, X1 INITIAL VAL *********************************************************** * PSEUDO-RANDOM NUMBER GENERATOR * X(N+1) = (A*X(N)+C) MOD M; RND = X/M * WHERE: X = X2 * 1E7 + X1 * A = A2 * 1E7 + A1 * C = C2 * 1E7 + C1 * M = 1E14 * ASSUMPTIONS: * (1) All numbers are integers; fractional parts are * truncated * (2) If the variables listed below start in the ranges * specified. They will also end in the ranges specified * * CONSTANTS: 0 <= A2 < 5E6 ; 0 <= C2 < 1E7 * 0 <= A1 < 5E6 ; 0 <= C1 < 1E7 * VARIABLES: 0 <= X2 < 1E7 ; 0 <= T1 <= 1E14 ; 0 <= T2 < 1E * 0 <= X1 < 1E7 ; 0 <= T3 <= 1E14 ; 0 <= T4 < 1E * * STACK USAGE: * CONSTANT REFS CONTANT REFS CONTANT REF * +---------+ IN/OUT IN/OUT IN/OUT * | STACK+4 | X2*A1(F)(H) -- ---- -- ---- * +---------+ * | STACK+3 | T2 (C)(J) -- ---- -- ---- * +---------+ * | STACK+2 | T1 (B)(D) new X1 (E)(N) -- ---- * +---------+ * | STACK+1 |old X1(A)(G) T3 (K)(L) new X2 (M)(P) * +---------+ *********************************************************** * COMPUTE NEW VALUE FOR X1, SAVE IT IN V@RNDX1 * STACK * SREFS FAC CONTENTS NRND MOVE 5,V@RNDX1,@FAC FAC = X1 CLR @FAC5 FAC = CLR DCLR @FAC6 FAC = CLR XML VPUSH (A) FAC = X1 MOVE 8,G@RNDA1,@ARG ARG = A1 XML FMUL FAC = X1*A1 MOVE 8,G@RNDC1,@ARG ARG = C1 XML FADD T1=FAC = X1*A1+C1 XML VPUSH (B) FAC = T1 MOVE 8,G@RNDEM,@ARG ARG = 1/1E7 XML FMUL FAC = T1/1E7 CALL GRINT T2=FAC = INT(T1/1E7) XML VPUSH (C) FAC = T2 MOVE 8,G@RNDEP,@ARG ARG = 1E7 XML FMUL FAC = T2*1E7 DSUB 8,@VSPTR XML SSUB (D) X1=FAC = T1-T2*1E7 MOVE 5,@FAC,V@RNDX1 FAC = X1 (new) XML VPUSH (E) FAC = X1 * COMPUTE NEW VALUE FOR X2, SAVE IT IN V@RNDX2 MOVE 5,V@RNDX2,@FAC FAC = X2 CLR @FAC5 FAC = CLR DCLR @FAC6 FAC = CLR MOVE 8,G@RNDA1,@ARG ARG = A1 XML FMUL FAC = X2*A1 DADD 8,@VSPTR XML VPUSH (F) FAC = X2*A1 DSUB 24,@VSPTR XML VPOP (G) FAC = X1 DADD 32,@VSPTR MOVE 8,G@RNDA2,@ARG ARG = A2 XML FMUL FAC = X1*A2 XML SADD (H) FAC = X2*A1+X1*A2 MOVE 8,G@RNDC2,@ARG ARG = C2 XML FADD FAC = X2*A1+X1*A2 XML SADD (J) T3=FAC = X2*A1+X1*A2 DSUB 16,@VSPTR XML VPUSH (K) FAC = T3 MOVE 8,G@RNDEM,@ARG ARG = 1/1E7 XML FMUL FAC = T3/1E7 CALL GRINT T4=FAC = INT(T3/1E7) MOVE 8,G@RNDEP,@ARG ARG = 1E7 XML FMUL FAC = T4*1E7 XML SSUB (L) X2=FAC = T3-T4*1E7 MOVE 5,@FAC,V@RNDX2 FAC = X2 (new) * COMPUTE NEW VALUE FOR RND, LEAVE IT IN FAC MOVE 8,G@RNDEM,@ARG ARG = 1/1E7 XML FMUL FAC = X2/1E7 XML VPUSH (M) FAC = X2/1E7 DADD 8,@VSPTR XML VPOP (N) FAC = X1 XML FMUL FAC = X1/1E7 XML FMUL FAC = X1/1E14 XML SADD (P)RND=FAC = (X2/1E7)+(X1/1E14) XML CONT *********************************************************** * CONSTANTS FOR THE RANDOM NUMBER ROUTINE RNDA2 BYTE >43,>01,>2B,>59,>52,>00,>00,>00 * = 1438982 RNDA1 BYTE >42,>2A,>08,>15,>00,>00,>00,>00 * = 0420821 RNDC2 BYTE >43,>02,>0B,>20,>30,>00,>00,>00 * = 2113248 RNDC1 BYTE >43,>06,>36,>05,>13,>00,>00,>00 * = 6540519 RNDEP BYTE >43,>0A,>00,>00,>00,>00,>00,>00 * = 1E7 RNDEM BYTE >3C,>0A,>00,>00,>00,>00,>00,>00 * = 1/1E7 *********************************************************** * RANDOMIZE STATEMENT *********************************************************** NRNDMZ CALL CHKEND Seed provider? BS RNDM1 No * RANDOMIZE given a see value * (99,000,000,000,001 possible starting positions) * (Place-value is ignored in the input number) XML PARSE Parse the seed BYTE TREMZ * Up to end of statement CALL CKSTNM DCZ @FAC Check FAC for zero BS GA3B6 ST >46,@FAC 0 < FAC < 1E14 XML VPUSH Let FAC = X2*1E7+X1 MOVE 8,G@RNDEM,@ARG ARG = 1/1E7 XML FMUL FAC = X2+X1/1E7 CALL GRINT FAC = X2 MOVE 5,@FAC,V@RNDX2 FAC = X2 MOVE 8,G@RNDEP,@ARG ARG = 1E7 XML FMUL FAC = X2*1E7 XML SSUB FAC = X1 MOVE 5,@FAC,V@RNDX1 FAC = X1 XML CONT FAC = X1 GA3B6 DST @FAC,V@RNDX2 FAC = 0 DST @FAC,V@RNDX1 FAC = 0 XML CONT * RANDOMIZE given number seed value (use GPL RAND function) * (16K possible starting positions) RNDM1 DST >4201,@FAC FAC = >4201 CLR @FAC4 FAC4= >00 CALL RNDMZ DATA RNDX1 CALL RNDMZ Set up seed DATA RNDX2 XML CONT Continue on RNDMZ FETCH @FAC8 Fetch address of seed (high b FETCH @FAC9 Fetch address of seed (low by RAND 99 GPL Randomize ST @RANDOM,@FAC2 >00<=FAC+2<=FF SRL 2,@FAC2 >00<=FAC+2<=3F RAND 99 GPL Randomize ST @RANDOM,@FAC3 >00<=FAC+3<=FF SRL 2,@FAC3 >00<=FAC+3<=3F MOVE 5,@FAC,V*FAC8 Put in seed RTN CKSTNM CEQ >65,@FAC2 BS ERRSNM RTN FLT1 BYTE >40,>01,>00,>00,>00,>00,>00,>00 *********************************************************** * EXTENDED STRING PACKAGE * THE ROUTINES ARE: * LITS05 - Move a string literal from the program to the * string space * INTARG - Checks that an argument is a numeric and * converts it from floating point to an integer * PUSSTR - Checks that an argument is a string and pushes * it on the stack * CONCAT - Concatenates 2 strings together * SEG$ - Segments a string * LEN - Puts the length of a string in the FAC * CHR$ - Converts an integer into its ASCII character * STR$ - Converts a number into its string equivalent * VAL - Converts a string into its numeric equivalent * POS - Gives the position of one string within another * RPT$ - Generates a single string with multiple copies * of the original string * * AN ENTRY IN THE FAC LOOKS LIKE: * +------------+-----+----+-------------+-----------------+ * |addr of ptr | >65 | xx | addr of str | length of str | * +------------+-----+----+-------------+-----------------+ * FAC FAC2 FAC3 FAC4 FAC6 *********************************************************** * Support routine for functions to build FAC entry LITS05 CLR @FAC6 Need as a double-byte value DST @FAC6,@BYTES LENGTH FOR GETSTR ST @RAMTOP,@FAC8 Copy ERAM flag for later LITS07 XML GETSTR ALLOCATE STRING SPACE LITS08 DST >001C,@FAC SAVE ADDR OF STRING (SREF) DST @SREF,@FAC4 SAVE ADDR OF STRING DST >6500,@FAC2 INDICATES A STRING CONSTANT *********** COPY STRING INTO STRING SPACE ***************** LITS09 DCZ @BYTES If non-null string BS GA42B CZ @FAC8 BR GA420 MOVE @BYTES,V*TEMP5,V*SREF RTN * Else source string in ERAM GA420 DST @BYTES,@FFF1 FFF1 : BYTE COUNT DST @SREF,@EEE1 EEE1 : DESTINATION ADDR ON VD DST @TEMP5,@DDD1 DDD1 : Source addr in ERAM XML GVWITE Move data from ERAM to VDP GA42B RTN LITS06 CLR @FAC8 SET FLAG TO VDP BR LITS07 JUMP INTO CODE *********************************************************** * PUSSTR - Insures that the entry in the FAC is a string * and pushes it onto the stack. *********************************************************** PUSSTR CEQ >65,@FAC2 BR ERRSNM XML VPUSH PUSH THE ARGUMENT RTN *********************************************************** * CONCAT - CONCATENATES TWO STRINGS TOGETHER * INPUT : FLOATING POINT ACCUMULATOR ENTRIES * OUTPUT : CONCATENATED STRING AND (POSSIBLE) * ZEROED BACK-POINTERS FOR THE OLD STRINGS * USES : TEMP2, TEMP4 AND TEMP5 AS TEMPORARIES *********************************************************** CONCAT CLR @ERRCOD+1 CLEAR THE ERROR CODE CALL PUSSTR Push the string & get next to XML PARSE GET THE R.H. ARGUMENT BYTE CONCZ CEQ >65,@FAC2 If not string - error BR ERRSNM DST @FAC6,@BYTES GET R.H. LENGTH DADD V@6(@VSPTR),@BYTES ADD IN L.H. LENGTH DCH 255,@BYTES BR GA45B DST 255,@BYTES TRUNCATE IF TOO LONG WRNST1 CALL WARNZZ Display warning BYTE 19 * STRING TRUNCATED message GA45B DST @BYTES,@TEMP6 Keep length for later XML VPUSH XML GETSTR Alloccate the result string XML VPOP Retrieve R.H. MOVE 8,@FAC,@ARG XML VPOP Retrieve L.H. DST @FAC4,@TEMP5 Set ptr to L.H. ARG(for FREST DST @FAC6,@BYTES Length of L.H. ARG CLR @FAC8 Force VDP mode CALL LITS08 Set up FAC & copy L.H. ARG in DCZ @ARG6 If R.H. =0 don't copy BS CONC06 DST @SREF,@TEMP4 Get ptr to new string DADD @FAC6,@TEMP4 Ptr to where 2nd string begin DSUB @FAC6,@TEMP6 Length of 2nd string * (possibly truncated) BS CONC06 MOVE @TEMP6,V*ARG4,V*TEMP4 Copy in 2nd string DADD @TEMP6,@FAC6 Add in length of 2nd ARG * NOTE: FAC6 already contained length of 1st ARG from the * parse that was done on it CONC06 XML CONT Done. *********************************************************** * SEG$(A$,X,Y) - Extracts the desiginated string from A$. * X specifies the character position within A$ at * which the extraction begins. Y specifies the number * of characters to extract. * If X or Y is negative an error occurs. If X=0 an * error occurs. If Y=0 or X > Y then a null string is * is returned. If the ramaining length in A$ starting * at the postion specified by X is less than the length * specified by Y, then the remainder of A$ starting at * position X is returned. * INPUT - Control is turned over to SEG$ from PARSE. The * only requirement is that a SEG$ was encountered. * OUTPUT - The Floating Point Accumulator is set up with * the header for the segmented string. * USES - TEMP2 (Others in calls to GETSTR and LITS08) *********************************************************** SEGZ01 CALL LPAR Insure "(" parse and check ", CALL PUSSTR Push string and get next toke XML SPEED Get the position BYTE PARCOM * within the source string CALL INTARG CHECK & CONVERT ARG TO INTEGE DCZ @FAC CAN'T HAVE VALUE OF 0 BS ERRBV XML VPUSH PUSH THE ARG XML PARSE Get extraction length BYTE RPARZ XML SPEED Must have BYTE SYNCHK * ended on BYTE RPARZ * a right parenthesis CALL INTARG CHECK & CONVERT ARG TO INTEGE DST @FAC,@ARG Move extraction length XML VPOP Get position back DST @FAC,@ARG2 Move position XML VPOP Retrieve source string DST @ARG2,@TEMP2 Get position within string DCH @FAC6,@TEMP2 If position > length =>null BS SEGZ08 DADD @ARG,@TEMP2 Compute end of substring DSUB @FAC6,@TEMP2 Compute length beyond end DDEC @TEMP2 string DCGE 0,@TEMP2 BR SEGZ06 Fine if substring is shorter DST @FAC6,@ARG Else, truncate length of * substring DSUB @ARG2,@ARG Subtract position from source * length DINC @ARG Increment to include last cha SEGZ06 DST @ARG,@BYTES # of bytes needed for substri XML VPUSH Save source string entry XML GETSTR ALLOCATE RESULT STRING XML VPOP Restore source string entry DST @FAC4,@TEMP5 Pointer to source for FRESTR * LITS08 DADD @ARG2,@TEMP5 Pointer to start of substring DDEC @TEMP5 Decrement since zero-based DST @BYTES,@FAC6 Set length of string CLR @FAC8 FORCE VDP MODE CALL LITS08 Copy in & set up FAC XML CONT SEGZ08 DCLR @ARG Extract a null string BR SEGZ06 >>>JUMP ALWAYS<<< *********************************************************** * LEN(A$) - Calculate the length of a string and leave the * result in the FAC. * CONTROL - Turned over to NLEN from the parser. * USES - No temporaries. *********************************************************** LEN01 CALL PARFF Insure left parenthesis & par BR ERRSNM If not string value DST @FAC6,@FAC Length LEN02 XML CIF Convert integer to floating p XML CONT *********************************************************** * CHR$(X) - Takes integer value X and converts the number * into the ASCII representation for that number. * CONTROL - Turned over to NCHR by the parser. * OUTPUT - FAC is set up with the string entry * USES - Uses temproraries when invoking LITS06(LITSTR) *********************************************************** CHRZ01 CALL PARFF Insure left parenthesis & par CALL INTARG Convert into integer DST 1,@BYTES Create a length 1 string ST @FAC1,V@ONECHR Move the value to VDP(for LIT DST ONECHR,@TEMP5 Address of character CALL LITS06 Create string and set up FAC DST 1,@FAC6 Length of string XML CONT *********************************************************** * ASC(A$) - Takes the numeric value of the first character * in A$. *********************************************************** ASC01 CALL PARFF Insure left parenthesis & par BR ERRSNM If not string CZ @FAC7 Bad Argument? BS ERRBA ST V*FAC4,@FAC1 Get the first character CLR @FAC BR LEN02 USE COMMON CODE >>>JUMP ALWAY *********************************************************** * STR$(X) - Takes as its imput an integer X and converts it * to its string representation. * CONTROL - Turned over to STR$ by the parser. * USES - The usual temporaries used by string function * when it calls LITS06. Uses the Roll-out area * for a temporary storage area when allocating * the result string. * OUTPUT - FAC is set up in the usual manner for a string *********************************************************** STRZ01 CALL PARFF Insure left parenthesis & par BS ERRSNM If not numeric-error CLR @FAC11 Select XB floating type XML CNS Convert the number to string CEQ SPACE,*FAC11 If leading space BR GA53E INC @FAC11 Suppress it out DEC @FAC12 Shorten the length GA53E CLR @BYTES Prepare for 2-byte value ST @FAC12,@BYTES+1 Get length of string MOVE @BYTES,*FAC11,V@VROAZ Put the string in VDP DST VROAZ,@TEMP5 Copy-from address(for LITSTR) CALL LITS06 Allocate and set up FAC DST @BYTES,@FAC6 Put in the length XML CONT *********************************************************** * VAL(A$) - Takes as its input a string, A$, and converts * the string into a number if the string is a * valid representation of a number. * CONTROL - From the parser. * OUTPUT - FAC contains the floating point number. *********************************************************** VAL01 CALL PARFF Insure left parenthesis & par BR ERRSNM If not string - error CZ @FAC7 Can't have null string BS ERRBA CALL VALCD So bad argument error BS ERRBA XML CONT * Short routine to parse a single argument enclosed in * parenthesis for a function or a subprogram and set * condition based upon whether the value parsed was a * string or a numeric. PARFF CEQ LPARZ,@CHAT BR ERRSYN XML PARSE BYTE >FF * CEQ >65,@FAC2 RTNC VALCD DST @FAC4,@TEMP5 Pointer to string DADD @FAC6,@TEMP5 Pointer to trailing length by DST @FAC6,@BYTES For suppressing trailing blan DINC @BYTES Prepare for undue subtraction GA57C DDEC @TEMP5 Keep track of end of string DDEC @BYTES Decrease length of string BS RTNSET End up with empty string, CEQ SPACE,V*TEMP5 Wild trailing blanks BS GA57C DINC @BYTES Allow for terminator XML VPUSH Save the ptr to the string XML GETSTR Get a new string XML VPOP Retrieve the ptr to the strin DST @FAC4,@TEMP5 Get the ptr to the string CLR @FAC8 Force VDP mode CALL LITS09 Copy the string and set up FA DADD @SREF,@BYTES Point to the trailing length DDEC @BYTES Point at the last character ST SPACE,V*BYTES Put in the terminator DST @SREF,@FAC12 Address for the conversion GA5A4 CEQ SPACE,V*FAC12 While leading spaces BR GA5AE DINC @FAC12 Skip leading blank BR GA5A4 GA5AE CLR @FAC2 Get rid of string (in case=0) CLR @FAC10 Assume no error XML CSNUM Convert it DCEQ @BYTES,@FAC12 Convert all of it? BS WRNNO Yes, check overflow & return RTNSET CEQ @>8300,@>8300 No, return with condition set RTNC *********************************************************** * POS(A$,B$,X) - Attempts to match the string, B$, in A$ * beginning at character # X in A$. If X is > LEN(A$), a * match is not found or A$ is the null string then the * returned value is 0. If B$ is the null string then the * returned value is 1. Otherwise, the returned value is * the column # of the 1st character matched in A$ * CONTROL - Fromn the parser. Returned through common code * IN LEN. * USES - Not temporaries - Utilizes FAC and ARG. *********************************************************** POS01 CALL LPAR Insure "(", parse , insure ", CALL PUSSTR STACK THE STRING AND GET TOKE XML SPEED Parse the match string and BYTE PARCOM * insure end on comma CALL PUSSTR STACK THE STRING AND GET TOKE XML PARSE Get position BYTE RPARZ XML SPEED Must have BYTE SYNCHK * ended on a BYTE RPARZ * right parenthesis CALL INTARG Check and convert it DCZ @FAC Value out of range BS ERRBV DST @FAC,@BYTES Keep the offset DDEC @BYTES Correct for position 0 XML VPOP Get match string back MOVE 8,@FAC,@ARG Put match in ARG XML VPOP Get source back CZ @FAC7 If source null BS POS12 CH @BYTES+1,@FAC7 OFFSET > LENGTH? BR POS12 Yes, no match possible CZ @ARG7 If null string BS POS06 DADD @BYTES,@FAC4 Adjust ptr for offset SUB @BYTES+1,@FAC7 Adjust length POS02 CHE @ARG7,@FAC7 Enough space left for a match BR POS12 No, no match possible DST @FAC4,@FAC Get first ARG DST @ARG4,@ARG Get second ARG ST @ARG7,@ARG8 And length of second POS04 CEQ V*FAC,V*ARG Compare the characters BR POS10 Didn't match DINC @FAC Next in source DINC @ARG Next in match DEC @ARG8 Reached end of match? BR POS04 Not yet, so loop POS06 INC @BYTES+1 Matched! Correct for 1 index POS08 DST @BYTES,@FAC Character position of match BR LEN02 Convert to floating point * NOTE: Utilizes the LEN code to do the conversion and * finish up. POS10 INC @BYTES+1 Step index of match character DEC @FAC7 Move 1 position down 1st DINC @FAC4 Argument BR POS02 Try to match again * JUMP ALWAYS POS12 CLR @BYTES+1 NO MATCH POSSIBLE BR POS08 *********************************************************** * RPT$(A$,X) - Creates a string consisting of X copies of * A$. If X is negative or non-numeric, an * exception occurs. If A$ is not a string, an * exception occurs. *********************************************************** RPTZ01 CALL LPAR Insure "(", parse, insure "," CALL PUSSTR Insure a string and push it XML PARSE Parse second argument BYTE RPARZ XML SPEED Must have BYTE SYNCHK * ended on a BYTE RPARZ * right parenthesis CALL INTARG Check numeric and convert DMUL V@6(@VSPTR),@FAC Compute result length DCZ @FAC1 BS GA649 WRNST2 CALL WARNZZ Give truncation message BYTE 19 * STRING TRUNCATED message DST 255,@FAC2 Make it a maximum string GA649 DST @FAC2,@BYTES Copy requested string length XML GETSTR Get the new string XML VPOP Retrieve the original string * At this point BYTES should still contain the length DST @FAC6,@ARG Copy original length in ARG DCZ @BYTES Zero copies requested BR GA659 DCLR @ARG So we copy zero!!!!!!! GA659 DEX @ARG,@BYTES Original length to BYTE DST @FAC4,@TEMP5 And also original start addr CLR @FAC8 Clear flag for LITS08 CALL LITS08 Create FAC and copy on copy * ARG contains total length now. DST @ARG,@FAC6 Store new length RPTZ02 DSUB @BYTES,@ARG Subtract one copy DCZ @ARG <<<<<THE WAY OUT BS XMLCON DADD @BYTES,@SREF Compute new start address DCH @ARG,@BYTES BR GA679 DST @ARG,@BYTES Truncate string GA679 MOVE @BYTES,V*TEMP5,V*SREF BR RPTZ02 *********************************************************** * TRACE STATEMENT *********************************************************** NTRACE OR >10,@FLAG Set the trace bit XMLCON XML CONT Continue on *********************************************************** * UNTRACE STATEMENT *********************************************************** NUNTRC AND >EF,@FLAG Reset the trace bit XML CONT Continue on *********************************************************** * BREAK AND UNBREAK STATEMENTS *********************************************************** NBREAK ST >FF,@ARG BREAK flag CALL CHKEND Check for end of statement BR LINEGP If not goto LINEGP DDEC @PGMPTR Back up so CON will rescan en CZ @PRGFLG Rative without line # BR EXEC6C ERROLP CALL ERRZZ Only legal in a program BYTE 27 NUNBRK CLR @ARG UNBREAK flag for common CALL CHKEND Check for end of statement BS UNBK01 If end then goto UNBK01 LINEGP CALL LINE Get line # DST @ENLN,@ARG2 DSUB >03,@ARG2 1st line # LNGP1 DCHE @STLN,@ARG2 If line not found BR WRNLNF CALL GRSUB3 Read line # of data from ERAM BYTE >5E * (use GREAD1) or VDP * @ARG2: Source addr in ERAM/VDP, reset possible breakpoint DCEQ @FAC,@EEE1 If line found BS LNGP2 DSUB 4,@ARG2 Next line in VDP or ERAM BR LNGP1 * JUMP ALWAYS LNGP2 CZ @RAMTOP If ERAM exists BS GA6DA AND >7F,@EEE1 Assume UNBREAK flag CZ @ARG If BREAK flag BS GA6D1 OR >80,@EEE1 Set the breakpoint GA6D1 CALL GWSUB Write a few bytes of data to * ERAM (use GWRITE) BYTE >5E,>58,>01 * ARG2,EEE1,1 * @ARG2: Destination addr on ERA * @EEE1: Data * 1 : Byte count B LNGP2B GA6DA AND >7F,V*ARG2 Assume UNBREAK flag first CZ @ARG If BREAK flag BS LNGP2B OR >80,V*ARG2 Set the breakpoint LNGP2B CALL CHKEND Check for end of statement BS LNGP4 If end then continue XML SPEED Must be BYTE SYNCHK * at a BYTE COMMAZ * comma now BR LINEGP * JUMP ALWAYS WRNLNF CALL WARNZZ Note: warning not error BYTE 38 * 'LINE NOT FOUND' BR LNGP2B And contiue on * JUMP ALWAYS UNBK01 CALL UBSUB Clear all bkpt in line # tabl LNGP4 XML CONT Contiue * CLEAR ALL BREAKPOINTS UBSUB DST @STLN,@FAC8 END OF LINE # BUFFER GA6FF CALL UBSUB1 Reset one line # at a time DADD 4,@FAC8 Got to the next line DCH @ENLN,@FAC8 End of table BR GA6FF RTN UBSUB1 CALL GRSUB3 Read the line # from ERAM/VDP * Reset possible bkpt too BYTE >52 * @FAC8: Source addr on ERAM/VD CALL GWSUB Write a few bytes of data to * ERAM(use GWRITE) or VDP BYTE >52,>58,>01 * FAC8,EEE1,1 * @FAC8: Destination adr in ERAM/V * @EEE1: Data * 1 : Byte count RTN *********************************************************** * USER DEFINED FUNCTIONS * Subroutine to store away the information of the tokens in * a function reference, go into the 'DEF' statement, * calculate the value of the expression and then resume * execution of the user's program after the reference. * An entry in the FAC and on the stack for a function * reference looks like: * +--------+-----+---------------------+--------+---------+ * | PGMPTR | >68 | string/numeric flag | SYMTAB | FREPTR | * +--------+-----+---------------------+--------+---------+ * FAC FAC2 FAC3 FAC4 FAC6 * * The 'PGMPTR' is where execution resumes after evaluating * the function. String (80)/numeric(00) flag is function * type. SYMTAB is the old symbol table pointer and FREPTR * is the old free space pointer. These are restored after * the function is evaluated. *********************************************************** UDF CZ @PRGFLG If imperative BR GA720 CZ @RAMTOP+1 And ERAM, error BR ERROLP GA720 CLR @FAC7 Assume no args DCLR @ERRCOD Clear the error code for cont CLR @ARG2 Safety for VPUSH CLR @FAC2 Sagety for VPUSH CEQ LPARZ,@CHAT BR GA73B XML VPUSH Save ptr to function definiti XML PARSE PARSE to get arg value BYTE >FF MOVE 8,@FAC,@ARG Save PARSE result XML VPOP Get S.T. ptr to function defi INC @FAC7 Indicate theat we have an arg GA73B ST @FAC7,@TEMP5 Move the parmeter count DST @FAC,@TEMP4 S.T. ptr to definition XML VPUSH Allow room for UDF result MOVE 8,@ARG,@FAC Retrieve parse result XML VPUSH Save parse result ST V*TEMP4,@FAC2 Get S.T. declarations ST @FAC2,@FAC3 Do this to save string bit * NOTE: THIS IS TO ALLOW THE CHECKING AFTER THE FUNCTION HA * BEEN EVALUATED TO MAKE SURE THE FUNCTION * TYPE (STRING/NUMERIC) MATCHES THE RESULT IT PRODUCE AND >07,@FAC2 Mask all but # of parameters CEQ @TEMP5,@FAC2 BR ERRIAL * Incorrect argument list error above. DST @PGMPTR,@FAC Will resume execution here ST >70,@FAC2 Entering parameter into symbo * table while in UDF statement executing AND >80,@FAC3 Mask all but string bit DSUB 16,@VSPTR Get below parse result DST @SYMTAB,@FAC4 Save current symbol table ptr DST @FREPTR,@FAC6 Save current free space ptr XML VPUSH Save the return info DADD 8,@VSPTR Get back to parse result *********** SHIFT EXECUTION TO FUNCTION DEFINITION ******** DST V@6(@TEMP4),@PGMPTR Set text ptr to definiti XML PGMCHR Get 1st character in the defi CH >A4,@SUBSTK Stack overflow BS ERRSO MOVE 24,@>8300,V@VROAZ Roll out temporaries OR >08,@FLAG Set function flag for ENTER ST >80,@XFLAG Make calls look like ENTERX CEQ EQUALZ,@CHAT BR GA79C * NOTE: This is to keep the global/local variables correct * the event that a function uses another function in * its evaluation. CLR @FAC15 Create a dummy entry in table CALL ENT09 for no-paremter function DDECT @PGMPTR Back up to equal sign CLR V@2(@VSPTR) This is to keep ASSGNV(called * below) not to screw up in * case FAC2 happens to have a * value (greater) >65 BR GA79F GA79C CALL ENTER Enter the parameter GA79F XML PGMCHR Get the '=' (Checked in PSCAN AND >F7,@FLAG Reset to normal ENTERs MOVE 24,V@VROAZ,@>8300 ST >68,V@-6(@VSPTR) Correct stack entry ID DST V@SYMBOL,V@2(@SYMTAB) Fudge link to * get global values DST @SYMTAB,@FAC Set up for SMB XML SMB Get value space MOVE 8,@FAC,@FAC8 Destination XML VPOP Get arg back MOVE 8,@FAC,@ARG Argument value MOVE 8,@FAC8,@FAC Destination XML VPUSH Push to destination MOVE 8,@ARG,@FAC Argument value CEQ >65,@FAC2 If a string BR GA7E2 DCEQ >001C,@FAC If not temp BS GA7E2 DST V*FAC,@FAC4 Get new location of string * Parameter was allocated in S. GA7E2 XML PGMCHR Skip the '=' XML ASSGNV Assign the value to the param XML PARSE PARSE to end of function defi BYTE TREMZ **** CHECK FOR TYPE MATCH (STRING/STRING OR NUM/NUM)******* **** BETWEEN THE RESULT AND THE FUNCTION TYPE ************* CEQ >65,@FAC2 If result string BR GA7F6 CZ V@3(@VSPTR) If functional BS ERRSNM BR GA7FC not a string GA7F6 CZ V@3(@VSPTR) If functional BR ERRSNM ***** NOW RESTORE SYMBOL TABLE AND RESUME ***************** ***** EXECUTION AT THE ORIGINAL LINE ********************** GA7FC CALL DELINK Delink the parameter entry DST V@8(@VSPTR),@PGMPTR Manual pop to get ptr back DDEC @PGMPTR Back up text pointer XML PGMCHR Get next token XML CONT DELINK DST @SYMTAB,@TEMP5 Save addr of S.T. entry just * in case entry is a string * (must free the string) MOVE 4,V@4(@VSPTR),@SYMTAB Restore old symbol table * pointer and free space pointe * This handles the freeing of t * string value which was assign * to the parameter. CGE 0,V*TEMP5 If string parmeter BS GA84C DST V@6(@TEMP5),@TEMP5 Where the string is DCZ @TEMP5 If non-null string BS GA833 DST V@-3(@TEMP5),@TEMP2 Get backpointer DCHE @SYMTAB,@TEMP2 If not used BS GA833 DCLR V@-3(@TEMP5) Free up the string * This handles the special case of F$(X$)=X$ * The result, which was permanent, must be made a temp. GA833 CEQ >65,@FAC2 If string result BR GA84A DCHE @SYMTAB,@FAC If came from argument BS GA84A DCZ @FAC4 If non-null BS GA846 DCLR V@-3(@FAC4) Clear the backpointer GA846 DST >001C,@FAC Make it a temp GA84A BR GA856 If numeric parameter GA84C CZ @RAMTOP If ERAM exist BS GA856 DADD 8,@RAMFRE Remove 8 bytes of value GA856 DSUB 8,@VSPTR Trash the stack entry RTN And retrun ATTNUT XML PARSE BYTE RPARZ CALL CKSTNM CHECK FOR NUMERIC OR STRING XML SPEED Insure argument is in BYTE RANGE * range of 0-30 BYTE 0 DATA 30 SRL 1,@FAC1 0,1 : 0000 ATTENUATION * 2,3 : 0001 * 4,5 : 0010 * 6,7 : 0011 ETC... OR >F0,@FAC1 REGISTER BITS RTN *********************************************************** * SUBROUTINE TO SET POINTER TO EACH DATUM *********************************************************** DATAST DDEC @LNBUF Point to 1st byte of line ptr CALL GRSUB2 Read 2 bytes from VDP or ERAM BYTE LNBUF * (use GREAD1), @LNBUF: Source * * address in ERAM or VDP DST @EEE1,@DATA Put it in @DATA CALL SRDATA Look for 'DATA' on the line BR DATST1 OK, FOUND ANOTHER 'DATA' STMT DDECT @LNBUF NO DCEQ @STLN,@LNBUF BS GA887 DDEC @LNBUF Point to 1st token address BR DATAST GA887 CLR @DATA Indicate no data DATST1 RTN *********************************************************** * Subroutine to get line number and goto routine to display * it on the screen. *********************************************************** ASC CZ @RAMFLG BR GA897 DST V@-2(@EXTRAM),@ARG2 Get line # in BR GA8A5 GA897 DST 2,@FFF1 @FFF1 : Byte count DST @EXTRAM,@DDD1 @DDD1 : Source addr in ERAM DDECT @DDD1 XML GREAD1 Read data from ERAM DST @EEE1,@ARG2 @EEE1 : Destination addr on C GA8A5 AND >7F,@ARG2 Reset the breakpoint if any B DISO *********************************************************** * Code to decode error returned from ALC *********************************************************** ERORZ CASE @ERRCOD DECODE ERROR FROM INTERPRETER BR ERRSYN 0 SYNTAX ERROR BR ERRMEM 1 MEMORY FULL BR ERRBV 2 BAD VALUE BR ERRLNF 3 LINE NOT FOUND BR ERRSYN 4 SYNTAX BR ERRBS 5 BAD SUBSCRIPT BR ERRSNM 6 STRING-NUMBER MISMATCH BR ERRSO 7 STACK OVERFLOW BR ERRBA 8 BAD ARGUMENT BR ERRRWG 9 RETURN WITHOUT GOSUB BR ERRIAL A INCORRECT ARGUMENT LIST BR ERRFNN B FOR/NEXT NESTING BR ERRNWF C NEXT WITHOUT FOR BR ERRMUV D IMPROPERLY USED NAME BR ERRIAL E INCORRECT ARGUMENT LIST BR ERRRSC F RECURSIVE SUBPROGRAM CALL BR ERRSNF 10 SUBPROGRAM NOT FOUND BR ERROLP 11 ONLY LEGAL IN A PROGRAM BR ERRSNS 12 MUST BE IN SUBPROGRAM *********************************************************** * SUBROUTINE TO GET LINE # FOLLOWING 'BREAK', 'UNBREAK', * 'RESTORE' *********************************************************** LINE CEQ LNZ,@CHAT Should be line # reference BR ERRSYN XML PGMCHR Get high order line # ST @CHAT,@FAC Build result in FAC, FAC1 XML PGMCHR ST @CHAT,@FAC1 Low order line # XML PGMCHR Get token following line # RTN CONV1 CLR @FAC10 XML CSNUM Convert String to Number *********************************************************** ST @FAC10,V@CSNTP1 DST @FAC12,V@CSNTMP Save those in temporary, becaus * in ERROV : WARNING routine hav * FAC12 and FAC10 values changed *********************************************************** WRNNO CZ @FAC10 Numeric overflow BS GA8F9 CALL WARNZZ BYTE 2 GA8F9 RTN *********************************************************** * SUBROUTINE FOR 'GCHAR' *********************************************************** GCHAR CALL GPHV Get X,Y values GCHAR2 CALL NUMVAR Get pointer to return variabl MOVE 8,G@FLT1,@FAC Clear FAC ST @CB,@FAC1 Get the character SUB OFFSET,@FAC1 Remove screen offset CHE 100,@FAC1 BR GA919 EX @FAC1,@FAC2 DIV 100,@FAC1 INC @FAC GA919 XML ASSGNV Assign the value to the symbo * RXB PATCH CODE BR GCHARA *********************************************************** * SUBROUTINE FOR 'COLOR' *********************************************************** COLOR XML SPEED Must be BYTE SYNCHK * at a BYTE LPARZ * left parenthesis * RXB PATCH CODE COL08 DCLR @VAR0 Clear ALL pointer CEQ ALLZ,@CHAT ALL? BR COL09 No. ST ALLZ,@VAR0 Yes, store it in pointer DCLR @FAC Set 0 XML PGMCHR Skip ALL token. CALL COMMA2 Skip comma. BR COL21 Start ALL RXB routine COL09 CEQ NUMBEZ,@CHAT If sprite number specified BR COL20 CALL CHAR1 Check sprite number (SPNUM3) COL10 CALL SPCOL Put the color in SAL CEQ COMMAZ,@CHAT More color changes BR LNKRTN CALL CHAR2 Skip and get sprite number (S BR COL10 * This part for regular color change routine COL20 XML SPEED Parse the character BYTE PARCOM * set and insure a comma XML SPEED Insure in range of BYTE RANGE * 0<= x <= 14 * RXB PATCH CODE * BYTE 0,0,14 BYTE 0,0,16 COL21 DADD >080F,@FAC Color table addr(>0810 - >081 XML VPUSH Push table set address XML SPEED Parse the foreground color BYTE PARCOM * and insure a comma CALL RAN16 Error if >16 or <1 ST @FAC1,@VAR4 Save it SLL 4,@VAR4 Foreground color in 4 MSBits XML PARSE Get background color BYTE RPARZ CALL RAN16 Error if >16 or <1 OR @FAC1,@VAR4 Background color in 4 LSBits XML VPOP Get color table address ST @VAR4,V*FAC Load the colors into the tabl * RXB PATCH CODE CEQ ALLZ,@VAR0 ALL in pointer. BR COL22 No. MOVE 14,V*FAC,V@1(@FAC) Fill color table with values COL22 CEQ COMMAZ,@CHAT End of call. Go back. BR LNKRTN XML PGMCHR Skip "," BR COL08 Take care of the next set * CALL SPCOL -- Changes color of sprite. * Called also from SPRITE. SPCOL XML PARSE BYTE RPARZ * Get the color number CALL RAN16 Check range 1 - 16 ST @FAC1,V@3(@SPSAL) Store in SAL RTN *********************************************************** * INTARG - Insures that the value in FAC is a numeric, * converts it to integer, issues error message if * necessary or returns. *********************************************************** INTARG CH >63,@FAC2 If string - error BS ERRSNM CLR @FAC10 ASSUME NO ERROR OR WARNING DCLR @FPERAD XML FLTINT CZ @FAC10 If error BR ERRBV CGE 0,@FAC Can't be < zero BR ERRBV RTN * FAC IS SET UP WITH F.P. 1 JOYXY ST @VAR0,@FAC1 CZ @VAR0 If <>0 BR GA995 CLR @FAC (>0000000000000000) BR GA99D GA995 CGE 0,@VAR0 BS GA99D ST >BF,@FAC GA99D XML ASSGNV Assign the value RTN KEYJOY ST @FAC1,@VAR0 Keyboard selection CALL NUMVAR Get variable for key-code CEQ COMMAZ,@CHAT If not comma - error BR ERRSYN XML PGMCHR Get next character CALL NUMVAR Get variable for key-status ST @VAR0,@KEYBD Keyboard selection MOVE 8,G@FLT1,@FAC Set up float * RXB PATCH CODE ************* * SCAN SCAN the keyboard * CLR @KEYBD Clear the code(No affect on s CALL KEYSTR * RXB KEY STRING COMPARISON * RTNC Return scan condition code NUMVAR XML SYM Get the symbol name CLOG >C0,V*FAC Can't be string or function BR ERRMUV It is, IMPROPERLY USED NAME E XML SMB Get value pointer XML VPUSH Put on stack for ASSGNV RTN And return ATTREG DATA >8000,>A000,>C000, BYTE >9F,>BF,>DF,>FF,>00,>06 COMB CEQ LPARZ,@CHAT If not '(' - error BR ERRSYN RTN SQUISH MOVE 8,V*FAC8,@FAC Sneak it out DST @VSPTR,@FAC14 Now move stack to squish it DSUB @FAC8,@FAC14 out - # of bytes to move BS SQU05 If none to move MOVE @FAC14,V@8(@FAC8),V@-16(@FAC8) SQU05 DSUB 8,@VSPTR RTN *********************************************************** * SUBPROGRAM FOR CLEAR *********************************************************** CLEAR ALL SPACE+OFFSET Clear the screen ST 3,@XPT Initialize screen pointer BR LNKRT2 Return to caller *********************************************************** * SUBPROGRAM FOR VERSION *********************************************************** VERS CALL COMB Insure have left parenthesis CALL ERRC05 Get symbol information *---------------------------------------------------------- * Change version number to 110 6/16/81 DST 2001,@FAC XML CIF Convert to floating point *---------------------------------------------------------- BR ASSRTN Assign and return to caller * INIALIZATION DATA FOR SOUND FLTS BYTE >42,>0B,>12,>22,>00,>00,>00,>00 SNDREG BYTE >01,>FF,>01,>04,>9F,>BF,>DF,>FF,>00 *********************************************************** * SUBPROGRAM FOR 'SOUND' * Builds 2 blocks in VDP RAM * 1st BLOCK : >01,<ATTENUATION FOR NOISE>,<INTERRUPT COUNT> * 2nd BLOCK : >04,>9F,>BF,>DF,>FF,>00 *********************************************************** SOUND DCEQ VRMSND,@>83CC Insure previous sound started BS SOUND MOVE 9,G@SNDREG,V@VRMSND CALL LPAR Duration in milliseconds CGE 0,@FAC Don't wait for completion BS GAA39 DNEG @FAC of previous sound DCLR @PRTNFN Make GPL interpeters stop pre GAA39 XML SPEED Insure duration BYTE RANGE * is in range BYTE 1 * of 1 - 4250 DATA 4250 * Convert duration into 1/60s of a second DMUL 6,@FAC Duration * 6 DDIV 100,@FAC (duration * 6) / 100 CZ @FAC1 If duration =0 BR GAA4D INC @FAC1 Set it to 1/60th of a second GAA4D ST @FAC1,V@VRMSND+2 3rd byte of the 1st block * | INTERUPT COUNT *********************************************************** * SOUND TABLE OF 10 BYTES IN CPU RAM (>00 - >09) * >00 - >05 : FREQUENCY CONTROL * >06 - >08 : ATTENUATION CONTROL * >09 : NOISE CONTROL(non-zero = noise encountered) * >0A : POINTER FOR CURRENT FREQENCY CONTROL * >0B : POINTER FOR CURRENT ATTENUATION CONTROL * >00 , >01 FOR REG 0; * >02 , >03 FOR REG 1; * >04 , >05 FOR REG 2; * REG0 : >8000, REG1 : >A000, REG3 : >C000 * INITIALIZE ATTENUATION CONTROL * REG0 : >9F, REG1 : >BF, REG2 : >DF *********************************************************** MOVE 12,G@ATTREG,@>8300 SOUND1 XML SPEED Parse the frequency value BYTE PARCOM * and insure a comma CALL CKSTNM Must be a numeric CGE 0,@FAC Noise if negative BR SOUND2 MOVE 8,G@FLTS,@ARG Constant 111834 XML FDIV P = 111834/FREQUENCY XML SPEED Insure in range BYTE RANGE BYTE 3 * Range: 3 - 1023 DATA 1023 * GET THE 4 L.S.Bits BITS AND 6 M.S.Bits OF 'P' DSRC 4,@FAC SRL 4,@FAC DOR @FAC,*STADDR 1st byte of frequency control byt * BIT 7 6 5 4 3 2 1 * 1 <REG> 0 <L.S.B. 4 OF * 2nd byte of frequency control byt * 0 0 <M.S.B. 6 of 'P' INCT @STADDR Advance ponter for next time CALL ATTNUT Get attenuation * BIT 7 6 5 4 3 2 1 * 1 <REG> 1 0 0 0 AND @FAC1,*VAR2 1 <REG> 1 <ATTN/2 DB> INC @VAR2 Advance pointer for next time * CHECK FOR END OF SOUND CALL SOUND3 CEQ RPARZ,@CHAT End of statement? BS SOUND5 XML SPEED If not right parenthesis BYTE SYNCHK * then must be at BYTE COMMAZ * a comma CEQ 6,@STADDR If not 3 regs yet BR SOUND1 * 3 sound regs already - so must be noise control XML SPEED Get frequency (should be nois BYTE PARCOM * and insure a comma CALL CKSTNM Must be a numeric value CGE 0,@FAC If not noise-error BS ERRBV * NOISE CONTROL SOUND2 CEQ >FF,@>8309 * BAD ARGUMENT ERROR BR ERRBA DNEG @FAC -(FREQUENCY) XML SPEED Insure in range BYTE RANGE * of 1 - 8 BYTE 1 * DATA 8 DEC @FAC1 0 - 7 (2nd BIT: 'T') * OTH, 1ST BITS: ST @FAC1,@>8309 OR >E0,@>8309 Noise control byte: * BIT 7 6 5 4 3 2 1 0 * 1 1 1 0 0 <T> < S > * PUT ATTENUATION IN THE 2ND BYTE OF 1ST BLOCK CALL ATTNUT ST @FAC1,V@VRMSND+1 * 1 1 1 1 < ATTN/2 DB> BR SOUND3 Go check for end of list SOUND5 CLR @VAR5 Pointer to sound table SND05 CZ @PRTNFN Wait untild previous BS SOUND6 SCAN Is finished and BR SND05 look for a break-key CEQ BREAK,@RKEY If not break-key BR SND05 BR EXEC6C If BREAK-KEY encountered * LOAD SOUND TABLE SOUND6 ST *VAR5,@>8400 SOUND ADDRESS PORT INC @VAR5 Next byte in table CEQ >0A,@VAR5 If not finished BR SOUND6 DST VRMSND,@FAC Where the 2 blocks are I/O 1,@FAC Start sound from VDP list BR LNKRTN Return to caller *********************************************************** * SUBPROGRAM FOR 'HCHAR' *********************************************************** HCHAR CALL HVCHR Get X, Y values character, # DCZ @FAC If 0 characters BS HCHAR2 HCHAR1 BYTE >08,>E0,>00,>FB * FMT '@VAR0' Display horizo DDEC @FAC Done yet? BR HCHAR1 No, finish it * RXB PATCH CODE HCHAR2 CEQ COMMAZ,@CHAT BS HCHAR XPTRTN ST @MNUM,@XPT Restore X-pointer LNKRTN XML SPEED Must be at BYTE SYNCHK * a right BYTE RPARZ * parenthesis LNKRT2 CALL CHKEND Check end of statement BR ERRSYN If not end-of-stmt , error CALL RETURN Return to caller *********************************************************** * SUBPROGRAM FOR 'VCHAR' *********************************************************** VCHAR CALL HVCHR Get X, Y values character, # DCZ @FAC If 0 characters BS VCHAR2 VCHAR1 BYTE >08,>E0,>00,>9E,>FB * FMT '@VAR0',>31 Display v DDEC @FAC Done yet? BS VCHAR2 Yes, return CZ @YPT If not at start of colunm BR VCHAR1 INC @XPT Move X-ptr to right one colun B VCHAR1 * RXB PATCH CODE VCHAR2 CEQ COMMAZ,@CHAT BS VCHAR BR XPTRTN *********************************************************** * SUBPROGRAM FOR 'CHAR' *********************************************************** CHARLY CALL COMB CHAR5 XML PGMCHR Skip "(" or "," * RXB PATCH CODE CEQ ALLZ,@CHAT BR GAB1F XML PGMCHR CALL COMMA2 ST ALLZ,@VAR0 DST 32,@FAC BR GAB28 GAB1F XML SPEED Get the first value BYTE PARCOM * and insure a comma XML SPEED Insure in range BYTE RANGE * of 32 - 143 * RXB PATCH CODE BYTE 30 DATA 159 GAB28 DSLL 3,@FAC Convert chr number to address DADD >0300,@FAC CORRECT FOR OFFSET DST @FAC,@VARY Save it XML PARSE Get string BYTE RPARZ CEQ >65,@FAC2 MUST BE STRING BR ERRSNM MOVE 4,@FAC4,@VAR5 VAR5 pointer to string value * Start defining character description. * VARY Address of RAM for character description. * VAR5 Pointer to string value. * VAR7 Length of string value. * VAR9 Temporary counter. * VAR9+1 Temporary counter. DCH 64,@VAR7 Max 4 characters at a time BR CHAR40 DST 64,@VAR7 IGNORE THE EXCESSES CHAR40 DCHE SPRVB,@VARY Don't have space for BS CHARL4 ST ZERO,@FAC Floating Point Accumulator (> MOVE 15,@FAC,@FAC1 DCZ @VAR7 Fill with zero BS CHAR50 DCHE 16,@VAR7 BS GAB6B MOVE @VAR7,V*VAR5,@FAC Move whatever DCLR @VAR7 BR CHAR50 GAB6B MOVE 16,V*VAR5,@FAC Move one character DSUB 16,@VAR7 Less num of bytes to move DADD 16,@VAR5 Move pointer CHAR50 ST >4A,@VAR9 Move pointer (>4A=FAC) ST 1,@VAR9+1 B GAB84 GAB82 INC @VAR9+1 GAB84 CGT 8,@VAR9+1 BS GABC3 CLR @BYTES Clear dot-building byte CHARL2 SLL 4,@BYTES For loop(2 chars per byte) ST *VAR9,@ARG CHE ZERO,@ARG If < 0 BR ERRBV CGT NINE,@ARG If in 0-9 BR CHARL3 CHE A,@ARG If > 9 but < A BR ERRBV CH F,@ARG If > F BS ERRBV CHARL3 SUB ZERO,@ARG Character - >30 CH 10,@ARG If in A-F BR GABB1 SUB 7,@ARG Correct for that too GABB1 OR @ARG,@BYTES Dot expression INC @VAR9 CLOG 1,@VAR9 1st half of row finished? BR CHARL2 Yes, do 2nd half * (each takes half byte) ST @BYTES,V*VARY Load characters DINC @VARY BR GAB82 Load characters on next row GABC3 DCZ @VAR7 More char to describe BR CHAR40 * RXB PATCH CODE CEQ ALLZ,@VAR0 BR CHARL4 DCLR @VAR0 CHRFIL MOVE 8,V@>0400,V@>0408(@VAR0) DADD 8,@VAR0 DCEQ 94*8,@VAR0 BR CHRFIL CHARL4 CEQ COMMAZ,@CHAT More specified? BS CHAR5 BR LNKRTN Return *********************************************************** * SUBPROGRAM FOR 'KEY' *********************************************************** KEY CALL SPAR GET KEY UNIT * RXB PATCH LABEL ************ GABD1 XML SPEED Insure in range BYTE RANGE * of 0 - 5 BYTE 0 DATA 5 CALL KEYJOY Get variables for code and st * and scan keyboard * KEYJOY returns key status BS KEY1B KEY STATUS = 1 DNEG @FAC Assume status = -1 CEQ >FF,@RKEY But correct if = 0 BR KEY1B DCLR @FAC KEY STATUS = 0 KEY1B XML ASSGNV Assign value in variable DST >4001,@FAC Re-store F.P. 1 in FAC CZ @RKEY If key-code = 0 BS KEY2 CEQ >FF,@RKEY No key depressed, BS KEY1C key code assigned to -1 * FORMAT FOR KEYCODES ABOVE 99 ADDED FOR 99/4A HIGHEST * KEYCODE (OTHER THAN >FF) IS >C6=198 * 5/7/81 CHE 100,@RKEY BR GAC04 INC @FAC SUB 100,@RKEY ST @RKEY,@FAC2 FLOATING FORMAT (>4001__00000 B GAC07 GAC04 ST @RKEY,@FAC1 FLOATING FORMAT (>40__0000000 GAC07 BR KEY2A KEY1C DNEG @FAC KEY CODE ASSIGNED TO -1 BR KEY2A KEY2 DCLR @FAC (>000000000000000) KEY2A XML ASSGNV ASSIGN VALUE TO VARIABLE * RXB PATCH CODE ************* * BR LNKRTN BR SUBRTN *********************************************************** * SUBPROGRAM FOR 'JOYSTICK' *********************************************************** JOYST CALL SPAR KEY UNIT * RXB PATCH LABEL ************ GAC16 XML SPEED Insure in range BYTE RANGE * of 1 - 4 BYTE 1 DATA 4 CALL KEYJOY GET VARIABLES FOR X, Y * AND SCAN KEYBOARD ST @JOYY,@VAR0 JOYSTICK Y POSITION CALL JOYXY -4 to +4 DST >4001,@FAC Re-store F.P. 1 in FAC ST @JOYX,@VAR0 JOYSTICK X POSITION CALL JOYXY -4 to +4 * RXB PATCH CODE ************* * BR LNKRTN BR SUBRTN *********************************************************** * INSURE LEFT PARENTHESIS AND THEN PARSE TO A COMMA *********************************************************** * RXB PATCH CODE LPAR CEQ COMMAZ,@CHAT BS CPAR XML SPEED Must be BYTE SYNCHK * at a BYTE LPARZ * left parenthesis BR GAC35 CPAR XML SPEED BYTE SYNCHK BYTE COMMAZ * RXB PATCH LABEL *********** GAC35 XML PARSE Do the parse BYTE COMMAZ * Stop on a comma XML SPEED Must be BYTE SYNCHK * at a BYTE COMMAZ * comma RTN *********************************************************** * SUBROUTINE FOR 'RANGE' USED IN ALL SOUND AND GRAPHICS *********************************************************** RAN16 XML SPEED Insure in range BYTE RANGE * of 1 to 16 BYTE 1 DATA 16 DEC @FAC1 Adjust to internal range RTN *********************************************************** * SUBROUTINE TO GET ROW, COLUMN VALUES *********************************************************** * RXB PATCH CODE GPHV CALL LPAR Insure '(', parse, insure ',' * RXB PATCH CODE GPHVRC XML SPEED Insure in range BYTE RANGE * of 1 - 24 BYTE 1 DATA 24 DEC @FAC1 Adjust to internal range ST @XPT,@MNUM ST @FAC1,@YPT Set row pointer XML SPEED Get column value BYTE PARCOM * and insure a comma XML SPEED Insure in range BYTE RANGE * of 1 to 32 BYTE 1 DATA 32 DEC @FAC1 Internal range: 0 - 31 ST @FAC1,@XPT Set column pointer RTN * Subroutine to control border color * Character background is also affected since transparent * is used. BORDER CALL PARFF Insure '(' , and parse CALL RAN16 Check 1 - 16 & put in interna MOVE 1,@FAC1,#7 Load VDP register BR LNKRT2 Return to XB program * Get ROW, COLUMN VALUES AND NUMBER OF CHARACTERS HVCHR CALL GPHV Get X, Y VALUES XML PARSE BYTE RPARZ CALL INTARG ADD OFFSET,@FAC1 ST @FAC1,@VAR0 SAVE THE CHARACTER DST 1,@FAC ASSUME 1 CHARACTER CEQ RPARZ,@CHAT If not right parenthesis BS GAC95 XML SPEED Must be BYTE SYNCHK * at a BYTE COMMAZ * comma XML PARSE # OF CHARACTERS BYTE RPARZ CALL INTARG FLOATING TO INTEGER GAC95 RTN *********************************************************** * ERRWXY - Is the subroutine for CALL ERR(W,X,Y,Z) * The parameters indicate: * W - The error code # of the error * X - Indicates whether execution(-1) error or * I/O (0-255) error on LUNO 0-255 * Y - Indicates the severity code of the error * Z - Line number of the error * ERR Can be called with 2 forms: * CALL ERR(W,X,Y,Z) and CALL ERR(W,X) * If ERR is called and no error has occured then all * values returned are zero. *********************************************************** ERRWXY DST @VSPTR,@FAC8 Get a temp VSPTR GAC99 DCH @STVSPT,@FAC8 While not a bottom of stack BR GACD0 ST V@2(@FAC8),@ARG Keep ID code in ARG area CEQ >69,@ARG *** ERROR entry BR GACAF CALL SQUISH Squish it out of the stack XML VPUSH Put permanent copy of error * entry on stack BR ERR10 Jump out now * Jump always GACAF CEQ >67,@ARG *** FOR entry BR GACBA DSUB 32,@FAC8 Skip it BR GACCE GACBA CEQ >66,@ARG *** GOSUB entry BR GACC5 DSUB 8,@FAC8 Skip it BR GACCE GACC5 CEQ >6A,@ARG * SYNTAX ERROR BR ERRSYN DSUB 16,@FAC8 Skip it GACCE BR GAC99 GACD0 DST >0080,@FAC No error entry there so DST >6900,@FAC2 fake one DCLR @FAC4 DCLR @FAC6 ERR10 XML VPUSH Push the temporary entry on * top of stack * Code to get "W" in CALL COMB Check for left parenthesis CALL ERRC05 Pick up user's symbol ST V@-8(@VSPTR),@FAC1 Get error code XML CIF Convert it to floating XML ASSGNV Assign it * Code to get "X" in CALL ERRCOM Check syntax & get user's sym CLOG >80,V@-7(@VSPTR) If execution BR GAD03 MOVE 8,G@FLT1,@FAC Make it such DNEG @FAC Make it a negative BR GAD0B GAD03 ST V@-5(@VSPTR),@FAC1 Get I/O LUNO number XML CIF Convert it to floating GAD0B XML ASSGNV * Code to get "Y" in CEQ RPARZ,@CHAT If long form of CALL ERR BS GAD42 CALL ERRCOM Check syntax & get user's sym ST V@-7(@VSPTR),@FAC1 Get severity code AND >7F,@FAC1 Reset execution / I/O flag XML CIF Convert it XML ASSGNV Assign it * Code to get "Z" in CALL ERRCOM Check syntax & get symbol DST V@-2(@VSPTR),@FAC2 Get line pointer DST @FAC2,@FAC DCZ @FAC2 If line number exists BS GAD3E DDECT @FAC2 Point to the line # CALL GRSUB1 Read line # (2 bytes) from VD * or ERAM (use GREAD) BYTE >4C * @FAC2: Source addr on ERAM/VD DST @EEE,@FAC Put the line # in FAC AND >7F,@FAC Reset the breakpoint if any GAD3E XML CIF Convert it XML ASSGNV Assign it GAD42 XML VPOP Trash the temporary entry B LNKRTN Return from subprogram * Must be long branch because of AND above ERRCOM CEQ COMMAZ,@CHAT Check for comma BR ERRSYN ERRC05 XML PGMCHR Get the next character XML SYM Collect name & s.t. entry XML SMB Get value space XML VPUSH Push it CLR @FAC Set up for conversion RTN * CHANGE IN ADDRESS OF THE ERROR CALLS WILL AFFECT * THE FILE SUBS..... * ERROR messages called from this file ERRSYN CALL ERRZZ * SYNTAX ERROR BYTE 3 * (shared by SUBS) ERRSNM CALL ERRZZ * STRING-NUMBER MISMATCH BYTE 7 * (shared by SUBS) ERRMUV CALL ERRZZ * IMPROPERLY USED NAME BYTE 9 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 ERRRWG CALL ERRZZ * RETURN WITHOUT GOSUB BYTE 18 ERRBS CALL ERRZZ * BAD SUBSCRIPT BYTE 20 ERRLNF CALL ERRZZ * LINE NOT FOUND BYTE 22 ERRBA CALL ERRZZ * BAD ARGUMENTS BYTE 28 ERRBV CALL ERRZZ * BAD VALUE BYTE 30 * (shared by SUBS) ERRIAL CALL ERRZZ * INCORRECT ARGUMENT LIST BYTE 31 * (shared by SUBS) ERRSNF CALL ERRZZ * SUBPROGRAM NOT FOUND BYTE 37 * Other error messages appear in this program * ERRRDY * READY DATA 0 * ERRBRK * BREAK POINT DATA 1 * ERROLP * ONLY LEGAL IN A PROGRAM DATA 27 * * WRNN01 * NUMERIC OVERFLOW DATA 2 * WRNS02 * WRNST1 * STRING TRUNCATED DATA 19 * WRNST2 * WRNLNF * LINE NOT FOUND DATA 38 * *********************************************************** AORG >0E00 * SPRITE SUBROUTINES BRANCH TABLE CHAR1 BR SPNUM3 Called in CHARLY. EXEC CHAR2 BR SPNUM2 Called in CHARLY. EXEC BR $ Called in CHARLY. EXEC * SUBROUTINE LINK LIST LINKS1 DATA LINKS2 STRI 'SPRITE' DATA SPRTE LINKS2 DATA LINKS3 STRI 'DELSPRITE' DATA SPRDEL LINKS3 DATA LINKS4 STRI 'POSITION' DATA SPRPOS LINKS4 DATA LINKS5 STRI 'COINC' DATA ZSCOI LINKS5 DATA LINKS6 STRI 'MAGNIFY' DATA SPRMAG LINKS6 DATA LINKS7 STRI 'MOTION' DATA SPRMOV LINKS7 DATA LINKS8 STRI 'LOCATE' DATA SPRLOC LINKS8 DATA LINKS9 STRI 'PATTERN' DATA SPRPAT LINKS9 DATA LINKSA STRI 'DISTANCE' DATA ZSDIST LINKSA DATA LINKSB STRI 'SAY' DATA SAY LINKSB DATA LINKSC STRI 'SPGET' DATA SPGET LINKSC DATA LINKSD STRI 'CHARSET' DATA CHRSET *********************************************************** * CALL SPRITE(#SPRITE,CHAR,COLOR,Y,X,(YSPEED,XSPEED),...) *********************************************************** SPRTE CALL SPNUM1 Check sprite mode and skip "( CALL SPNUM2 Get sprite number SPRT3 CALL SPCHR Put character number for spri XML SPEED BYTE SYNCHK BYTE COMMAZ * Check for comma and skip it CALL GA01E Put sprite color in SAL (SPC XML SPEED Insure at a comma BYTE SYNCHK BYTE COMMAZ CALL SPLOC Put location of sprite in SAL DST @SP04+1,V*SPSAL Put in location of sprite * Finish defining SAL. Check if velocity is specified SPRT4 CEQ COMMAZ,@CHAT Finished!!!!! BR GB0F2 XML PGMCHR CEQ NUMBEZ,@CHAT Next sprite specified BR GAEBB CALL SPNUM3 Get the next sprite number BR SPRT3 And go! GAEBB CALL SPMOVE Get the velocity first BR SPRT4 *********************************************************** * CALL DELSPRITE(#SPR,.......) or CALL DESPRITE(ALL) *********************************************************** SPRDEL CALL SPNUM1 Insure at '(' SPDEL1 XML PGMCHR Skip "(" or "," CEQ NUMBEZ,@CHAT If sprite number BR GAEF6 XML PGMCHR Skip "#" XML PARSE Parse the sprite number BYTE RPARZ CALL SPNUM4 Check and convert number DCLR V@>0480(@SPSAL) Stop motion if moving DST >C000,V*SPSAL Hide the sprite off screen *---------------------------------------------------------- * Add following 7 lines for speeding up XBASIC CEQ @MOTION,V@SPNUM Check current sprite BR SPDEL2 * no. against sprite motion count * yes, change to as low as possible GAEE1 DEC @MOTION BS SPDEL2 DSUB 4,@SPSAL DCZ V@>0480(@SPSAL) BS GAEE1 *---------------------------------------------------------- SPDEL2 CEQ COMMAZ,@CHAT If more sprites BS SPDEL1 BR GAEFD GAEF6 XML SPEED Must have 'ALL' else error BYTE SYNCHK BYTE ALLZ CALL SPRINT Reinitialize all sprites GAEFD BR GB0F2 Return to caller *********************************************************** * CALL POSTION(#SPR,Y,X,...) *********************************************************** SPRPOS CALL SPNUM1 Check for sprites and skip "( SPRP02 CALL SPNUM2 Check sprite number CALL PREPN Prepare Y-position return var XML SPEED Insure at a comma BYTE SYNCHK BYTE COMMAZ DST V*SPSAL,@SP00 Read X, Y position ST @SP00,@FAC1 Get Y position CEQ >FE,@FAC1 BR GAF1C DINCT @FAC Get 256 as an output BR GAF1E GAF1C INCT @FAC1 Regular adjustment for user GAF1E CALL SPRP03 Check, convert & assign value CALL PREPN Prepare X-pos return variable ST @SP00+1,@FAC1 Get X position DINC @FAC Adjust for the user CALL SPRP03 Check, convert & assign value CEQ COMMAZ,@CHAT If not finished BS SPRP02 BR GB0F2 Return SPRP03 XML CIF Convert integer to float DCEQ >C000,@SP00 If hidden sprite BR GAF3D DCLR @FAC Return value zero GAF3D XML ASSGNV Assign to variable RTN *********************************************************** * CALL COINC(#SPR,#SPR,TOLERANCE,CODE) * CALL COINC(#SPR,YLOC,XLOC,TOLERANCE,CODE) * CALL COINC(ALL) *********************************************************** SPRCOI CALL SPNUM1 XML PGMCHR Skip "(" CEQ ALLZ,@CHAT Check coinc of all sprites BR GAF56 XML PGMCHR Skip "ALL" CALL COMMA2 Check and skip "," CLOG >20,@VDPSTT Check VDP status * RXB PATCH CODE ************ * BS NULRTN BS NR BR GAF6C * RXB PATCH CODE ************ GAF56 CALL CODIST Get distance of 2 sprites CALL COMMA Get tolerance level XML SPEED BYTE RANGE * Check against range BYTE 0 * FAC has tolerance level DATA 255 DCH @FAC,@SP00 Y-loc out of range * RXB PATCH CODE ************ * BS NULRTN BS NR DCH @FAC,@SP04 X-loc out of range * RXB PATCH CODE ************ * BS NULRTN BS NR * If no conincidence just return zero GAF6C CALL PREPN Prepare for numeric output DST >BFFF,@FAC Store -1 in FAC * RXB PATCH CODE ************ * BR ASSRTN BR AR *********************************************************** * CALL MAGNIFY(magnification factor=1 - 4) *********************************************************** SPRMAG CALL SPNUM1 Insure at "(" XML PGMCHR Skip the "(" XML PARSE Parse the magnification facto BYTE RPARZ XML SPEED BYTE RANGE BYTE 1 DATA 4 * Next statement adding >DF to subtract 1 from FAC ADD >DF,@FAC1 Turn on screen and interrupt MOVE 1,@FAC1,#1 Store it to VDP register 1 BR GB0F2 *********************************************************** * CALL MOTION(#SPR,YSPEED,XSPEED,...) *********************************************************** SPRMOV CALL SPNUM1 Insure at "(" * RXB PATCH CODE ************* * SPRMV2 CALL SPNUM2 Get sprite number SPRMV2 B SPGS GO or STOP SPRMV3 CALL SPMOVE Store velocity SPRMV4 CEQ COMMAZ,@CHAT Loop if more BS SPRMV2 BR GB0F2 *********************************************************** * CALL LOCATE(#SPR,YLOC,XLOC,...) *********************************************************** SPRLOC CALL SPNUM1 Insure at "(" SPRLC2 CALL SPNUM2 Check sprite number CALL SPLOC Read location DST @SP04+1,V*SPSAL Put in sprite location CEQ COMMAZ,@CHAT Loop if more BS SPRLC2 BR GB0F2 *********************************************************** * CALL PATTERN(#SPR,CHAR,...) *********************************************************** SPRPAT CALL SPNUM1 Insure at "(" SPRPT2 CALL SPNUM2 Get sprite number CALL SPCHR Set the sprite character CEQ COMMAZ,@CHAT Loop if more BS SPRPT2 BR GB0F2 *********************************************************** * CALL DISTANCE(#1,#2,DISTANCE) * CALL DISTANCE(#1,Y,X,DISTANCE) *********************************************************** DIST CALL SPNUM1 Insure at "(" * RXB PATCH LABEL ************ GAFC4 XML PGMCHR Skip "(" CALL CODIST Get distance in Y and X CALL PREPN Prepare return variable DMUL @SP00,@SP00 X=X*X DMUL @SP04,@SP04 Y=Y*Y DADD @SP06,@SP02 @SP02=X*X+Y*Y OVF Checking overflow bit BS OVER If overflow-indicate maximum DST @SP02,@FAC Put distance squared in FAC DCH >7FFF,@SP02 If bigger then 128 BR GAFE5 OVER DST >7FFF,@FAC Put maximum value GAFE5 XML CIF Convert to floating format * RXB PATCH CODE * BR ASSRTN Assign value and return BR AR *********************************************************** * CODIST routine gets locations of two sprites or one * sprite and Y and X position specified by a user and * calculates absolute value of Y and X distance. *********************************************************** CODIST CLR @SP00 MOVE 7,@SP00,@SP00+1 Clear up first 8 bytes CEQ NUMBEZ,@CHAT Check for # BR ERRSYN CALL SPNUM3 Get the first sprite DST V*SPSAL,@SP00+1 Location of first sprite INC @SP00+1 Increment to make range 1-256 ST @SP02,@SP02+1 Put X in SP02+1 CLR @SP02 Y in SP00+1 CEQ NUMBEZ,@CHAT Get 2nd sprite BR GB011 CALL SPNUM3 Get the next sprite DST V*SPSAL,@SP04+1 Location of second sprite BR GB017 GB011 CALL SPLOC Get Y and X location CALL COMMA2 Check for comma and skip GB017 INC @SP04+1 Increment to make range 1-256 DSUB @SP04,@SP00 Difference in Y at SP00 DABS @SP00 Get absolute value CLR @SP04+1 Clear byte before X DSUB @SP02,@SP04+1 Difference in Y at SP04 DABS @SP04+1 get the absolute value ST @SP06,@SP04+1 Put in the right place RTN *********************************************************** * CHRSET restores the standard character set and the * standard colors for the standard character set * (black on transparent) *********************************************************** CHRSET CALL CHKEND Must be at EOS now BR ERRSYN Else its an error ST >40,@FAC2 Number of characters to load CALL CHRTBL Call RXB routine to load ST >10,V@>080F Set 1st set to black on tranp MOVE 16,V@>080F,V@>0810 Ripple for rest CALL RETURN Return to the caller ****************************** * SPNUM1 ROUTINE * ****************************** SPNUM1 CEQ LPARZ,@CHAT Should be "(" BR ERRSYN RTN ****************************** * SPNUM2 ROUTINE * ****************************** SPNUM2 XML PGMCHR Get the next character SPNUM6 CEQ NUMBEZ,@CHAT Must be "#" BR ERRSYN SPNUM3 XML PGMCHR Get next character CALL COMMA Parse up to comma and skip it SPNUM4 XML SPEED BYTE RANGE * Verify the value is in range BYTE 1 * Sprite number 1 - 28 DATA 28 *---------------------------------------------------------- * Insert a line here in sprite handling code for speeeding * up XB 5/22/81 * RXB PATCH LABLE ************ SPNUM5 ST @FAC1,V@SPNUM Keep sprite number *---------------------------------------------------------- DEC @FAC1 Adjust for internal use DSLL 2,@FAC Get location of SAL DADD >0300,@FAC Sprite # * 4 + >0300 DST @FAC,@SPSAL Save SAL location RTN ****************************** * SPLOC ROUTINE * ****************************** SPLOC CALL COMMA Parse up to comma and skip it XML SPEED BYTE RANGE * Range of Y: 1 - 256 BYTE 1 DATA 256 DECT @FAC1 Adjust for internal use: FF - DST @FAC,@SP04 Store in SP04 area XML PARSE BYTE RPARZ * Parse to ")" or less XML SPEED BYTE RANGE * Get X value. Range: 1 - 256 BYTE 1 DATA 256 DEC @FAC1 Adjust for internal use: 0 - ST @FAC1,@SP06 SP04+1=Y-loc and SP06=X-loc RTN ****************************** * SPCHR ROUTINE * ****************************** SPCHR XML PARSE BYTE RPARZ XML SPEED BYTE RANGE * Check upper range * RXB PATCH CODE * BYTE 32 * Character value 32 - 144 * DATA 143 BYTE 30 DATA 159 ADD >60,@FAC1 Add offset to character numbe ST @FAC1,V@2(@SPSAL) Store the character value RTN ****************************** * SPMOVE ROUTINE * ****************************** SPMOVE CALL COMMA Parse up to comma and skip CALL RANGEV Check if numeric and convert * to integer ST @FAC1,@SPTMP Store Y velocity XML PARSE Get X velocity BYTE RPARZ * Check for ")" or less CALL RANGEV Numeric check and convert * to integer SPMOVF ST @SPTMP,@FAC * @FAC=Y velocity, @FAC1=X velo DST @FAC,V@>0480(@SPSAL) Store velocities in SAL *---------------------------------------------------------- * Add the following 3 lines for speeding up XB CH @MOTION,V@SPNUM Check current sprite BR GB0BD against sprite motion * counter ST V@SPNUM,@MOTION higher? Yes, replace it *---------------------------------------------------------- GB0BD RTN RANGEV CH >63,@FAC2 The same as INTARG BS ERRSNM CLR @FAC10 DCLR @FPERAD XML FLTINT CZ @FAC10 BR ERRBV DCGE 0,@FAC If positive number, BR GB0DB DCH >007F,@FAC should be 0 - 127 BS ERRBV BR GB0E1 If negative number, GB0DB DCHE >FF80,@FAC Should be -1 to -128 BR ERRBV GB0E1 RTN Otherwise its ok. ****************************** * COMMA ROUTINE * ****************************** COMMA XML PARSE BYTE COMMAZ COMMA2 CEQ COMMAZ,@CHAT BR ERRSYN XML PGMCHR Get next character RTN ****************************** * LINK BACK TO XB * ****************************** NULRTN CALL PREPN ASSRTN XML ASSGNV GB0F2 B GA01C (LNKRTN) ******************************* * PREPARE FOR PASSING ARGUMENT* ******************************* PREPN XML SYM Pick up name & search table XML SMB Evaluate any subscripts CH >63,@FAC2 If not numeric, error BS ERRIAL XML VPUSH Save entry on stack CLR @FAC Clear FAC for new value MOVE 7,@FAC,@FAC1 RTN *********************************************************** * CALL SAY(....................) * Decode given parameter(s). Store all data first, then go * speak it all at once. *********************************************************** SAY CEQ LPARZ,@CHAT Must start with "(" BR ERRSYN DST @VSPTR,@FAC2 Save current top of stack on XML VPUSH the stack DST 255,@BYTES 255 bytes = 85 3 byte entires XML GETSTR Get temp speech list string DST >001C,@FAC Indicate it is temp string (S DST >6500,@FAC2 Indicate it is string entry DST @SREF,@FAC4 Save pointer to temp string DST @BYTES,@FAC6 Length is 255 XML VPUSH Make it semi-permenant * Set up pointers into the speak list DST @FAC4,@PTFBSL Front points to begining DST @FAC4,@PTLBSL Last now points to beginning DST @PTFBSL,@PTEBSL DADD @FAC6,@PTEBSL End points to the end+1 CALL SETRW Set PHROM read/write address CALL WAIT Wait till no one is speaking DIRSPK CALL GETPRM Get next parameter BS NEXT1 If non-null ASCII string DST @FAC4,@PTFCIS Set up pointer to first char DST @FAC6,@PTLCIS Set ptr-to-last-char-in-strin DADD @PTFCIS,@PTLCIS by adding length-of-string DDEC @PTLCIS and subtracting 1 * Make a speech list CALL SETRW Set speech read/write addrs DST @PTFCIS,@PTCCIS Start at beginning of string CLR @TOTTIM Clear total time delay CALL GETTIM Get first timing mark CALL TIMING Get any subsequent marks * The total first time delay is in TOTTIM now GB158 DCH @PTLCIS,@PTCCIS While more string BS GB1A7 CALL PHRASE Get next phrase * If spell flag is 0, try to look the phrase up. If it * can not be found, then set the spell flag, and it will be * spelled out. If found, save on speak list. CZ @SPLFLG There is a phrase BR GB173 CALL LOOKUP Try to look it up in the PHRO DCZ @DATAAD If not found then BR GB170 ST 1,@SPLFLG Set the spell flag BR GB173 GB170 CALL STDATA Store data in list * If spell flag is 1, set time delay to >3C, and take the * phrase one character at a time (spell it). Look up each * character: if not found, use 'UHOH' data instead. * Regardless, store data on speak list. GB173 CEQ 1,@SPLFLG Need to spell it out? BR GB1A0 DST @PTLCIP,@PTLCIL Est last char to spell out ST >3C,@TOTTIM >3C used because sounds good * Take each single character * Skip over any embedded spaces encountered in a phrase GB17E CEQ SPACE,V*PTFCIP BR GB188 DINC @PTFCIP BR GB17E * Set first and last pointers to same one character GB188 DST @PTFCIP,@PTLCIP CALL LOOKUP Try to look it up * If not found, use data to 'UHOH' DCZ @DATAAD BR GB196 DST >71F4,@DATAAD Put addr of 'UHOH' in GB196 CALL STDATA Store data on speak list DINC @PTFCIP Go on to next character DCH @PTLCIL,@PTFCIP Until done all BR GB17E * At this point, get next timing group. The first timing * character has already been found, and it's value is still * in TIMLEN. Therefore, initiatory call to GETTIM not * needed. Simply clear TOTTIM and call TIMING. GB1A0 CLR @TOTTIM CALL TIMING BR GB158 * At this point, finished all the phrases in this string. * TOTTIM should equal >FE, it indicate end of sting If it * doesn't equal >FE, it indicates that a timing group was * put on the end of the string. Therefore, save the timing * group with a null data address to show it is only timing. GB1A7 CEQ >FE,@TOTTIM BS NEXT1 DCLR @DATAAD CALL STDATA * Next item could be direct string. NEXT1 CEQ COMMAZ,@CHAT If direct string present BR SPEAK CALL GETPRM Get the next parameter BS NEXT2 If non-null direct string ST >FF,@TOTTIM Mark TOTTIM as direct string XML VPUSH Save direct string on stack DST @VSPTR,@DATAAD Store stack addr on string CALL STDATA And add to the speak list * If the next character is a comma, loop thru it again NEXT2 CEQ COMMAZ,@CHAT BS DIRSPK * If end fall into SPEAK *********************************************************** * SPEAK will actually speak the speech list. It tests the * timing byte to see if it is an >FF. If it is, then the * data following it points to a direct speech data string * in VDP. If it is not, then the data following it points * to a PHROM speech data list. In the first case, this * routine will issue a speak external command to the PHROM * and then feed bytes out to the PHROM as it requests them. * In the second case, the address will be loaded out to the * PHROM, and then a speak command will be issued. *********************************************************** SPEAK CALL SETRW Set read/write address GB1CE DCHE @PTLBSL,@PTFBSL More speech list to go BS GB258 CALL WAIT Yes, wait until previous * speech is though CEQ >FF,V*PTFBSL External speech data BS GB1FE ST V*PTFBSL,@TIMER No, load timer NEG @TIMER and neg it to correct DST V@1(@PTFBSL),@PTFBPH Put addr into PTFBPH DADD 3,@PTFBSL and skip to next node LOOP1 CGE 0,@TIMER Wait for time delay BR LOOP1 CZ @PTFBPH If there is data BS GB1FC CALL LOADAD Load the addr to PHROM ST >50,@>8300(@WRITE) and issue speak command GB1FC BR CONTIN GB1FE DINC @PTFBSL Speak external, skip over >FF DST V*PTFBSL,@PTCBED Set up pointer to 1st byte DST V@4(@PTCBED),@PTCBED in external speech data DINCT @PTFBSL Skip addr bytes ST V@-1(@PTCBED),@LENWST Get Len of whole string DIRSPH SUB 3,@LENWST Minus 3 bytes overhead * All external speech strings start with a >60 CEQ >60,V*PTCBED Bad speech string BR ERRBV CALL WAIT Wait for go ahead DINCT @PTCBED Skip spk ext & 1st byte len ST V*PTCBED,@LENCST Get len of current string DINC @PTCBED Skip len byte to 1st real byt ST 16,@TEMP2 Do 1st 16 bytes (fill buff) ST >60,@>8300(@WRITE) Start Speak External LOOPR ST V*PTCBED,@>8300(@WRITE) Write byte to PHROM DINC @PTCBED Go to next byte DEC @LENWST 1 less char in whole string BS CONTIN Finished whole string? DEC @LENCST 1 less char in curr string BS DIRSPH Finished current string? DEC @TEMP2 1 less char in this loop BR LOOPR Not finished curr loop yet? GB241 ST @>8300(@READ),@SPKSTS Read status from PHROM * If the next statement is true, it means that speak was * probably interupted and that it is shot at this point. * Therefore, we are going to quit now. CLOG >80,@SPKSTS BS CONTIN CLOG >40,@SPKSTS Loop till buff below half BS GB241 ST 8,@TEMP2 Put 8 more bytes to PHROM BR LOOPR and go do these CONTIN B GB1CE We've said it all!! * Now pop all entries off stack that we put on! GB258 XML VPOP Free up a temporary string DCEQ @FAC2,@VSPTR BR GB258 BR GB0F2 And return to the caller *********************************************************** * SPGET subprogram. Load speech data from external device. * Use standard file I/O *********************************************************** SPGET CEQ LPARZ,@CHAT Must have left parenthesis BR ERRSYN CALL SETRW Set PHROM read/write address CALL WAIT Wait till no one is speaking NXTPAR CALL GETPRM Get the next parameter DCZ @FAC6 If non-null ASCII string BS GB318 DST @FAC4,@PTFCIS Pointer to 1st char in string DST @FAC6,@PTLCIS Pointer to last-char-in-strin DADD @PTFCIS,@PTLCIS by adding length-of-string DDEC @PTLCIS and subtracting 1 CALL SETRW Set the speech read/write add DST @PTFCIS,@PTCCIS Set curr char to first char CLR @TOTTIM Clear total time delay CALL GETTIM Get first timing mark CALL TIMING Get any subsquent marks * Get one phrase, and look it up. If the phrase is not foun * substitute in 'UHOH'. DCH @PTLCIS,@PTCCIS Possible phrase BS GB318 CALL PHRASE Yes, go get it CEQ 1,@SPLFLG Spell flag set then set BR GB29C DST @PTFCIP,@PTLCIP last ptr to first (1 char) GB29C CALL LOOKUP Look up the phrase DCZ @DATAAD If not there, BR GB2AA DST >71F4,@DATAAD use 'UHOH' data addr ST >51,@STRLEN 'UHOH' data length * Data must be in PHRADD and PHLEN, so move it GB2AA DST @DATAAD,@PHRADD ST @STRLEN,@PHLEN ADD 3,@PHLEN For overhead info * There must be a variable to put this data in. If not, err XML SPEED BYTE SYNCHK BYTE COMMAZ XML SYM Find symbol in table XML SMB Evaluate andy subscripts XML VPUSH Save for assignment CLR @BYTES Two byte value ST @PHLEN,@BYTES+1 Length of string needed XML GETSTR Get a string for the data CALL SETRW Set up speech read/write addr DST >001C,@FAC Now build string FAC entry DST >6500,@FAC2 String ID DST @SREF,@FAC4 Pointer to string DST @BYTES,@FAC6 Length of string DST >6000,V*SREF Mark string as speech data ST @PHLEN,V@2(@SREF) Put in string length DSUB 3,V@1(@SREF) minus thei info * LOADAD expects addr to be in PTFBPH, so move it. DST @PHRADD,@PTFBPH CALL LOADAD * Going to copy string from PHROM to VDP. The actual data * from PHROM is in bit-reversed order, so must reverse the * order after reading in the order. Remember that 3 bytes * PHLEN are our own overhead, so don't copy all GB2EB CH 3,@PHLEN BR GB316 ST >10,@>8300(@WRITE) Issue read byte command ST @>8300(@READ),@BYTE3 Read the byte * the following code is somewhat tricky. It will bit * reverse the contents of BYTE3 into BYTE1 through * BYTE2 by means of word shifts. Note the definition of * BYTE1 , BYTE2, and BYTE3 in EQU's. You might try an * example if it isn't clear what is going on. CLR @BYTE2 ST >08,@TEMP1 RNDAG DSRC 1,@BYTE2 DSLL 1,@BYTE1 DEC @TEMP1 BR RNDAG * Store the bit-corrected byte into the string & inc str pt ST @BYTE1,V@3(@SREF) DINC @SREF DEC @PHLEN Dec the string length BR GB2EB Go do next char if there is o GB316 XML ASSGNV Assign the string to variable GB318 CEQ COMMAZ,@CHAT If more go do BS NXTPAR BR GB0F2 *********************************************************** * GETPAM gets the next string paameter passed to the * routine. If that parameter is non-exist or null, then * condition bit is set. If the parameter is there then * condition bit is reset and the FAC entry describes the * string. In either case, return with condition is done. *********************************************************** GETPRM XML PGMCHR Get next token CEQ COMMAZ,@CHAT Go set condition no parm BS SETCB XML PARSE BYTE RPARZ CEQ >65,@FAC2 If not string, error BR ERRSNM DCZ @FAC6 Set cond if null string RTNC Else return SETCB CEQ @>8300,@>8300 Set condition bit RTNC *********************************************************** * Get the next phrase out of the current string. The phrase * may begin with a #, which means it will continue to the * next #, or it many begin with an ordinary character, in * which case it will end with the character just before the * first timing character encountered. In either case, the * end of the string will indicate a legal end of phrase if * it occurs before the usual indicator! *********************************************************** PHRASE CEQ NUMBER,@CCHAR Phrase start with #? BR GB370 DINC @PTCCIS Yes, inc CC ptr past # GB33C CEQ SPACE,V*PTCCIS Skip spaces BR GB346 DINC @PTCCIS BR GB33C GB346 CEQ NUMBER,V*PTCCIS All spaces? BR GB34F DINC @PTCCIS Yes, skip this # too RTN And ignore this phrase GB34F DST @PTCCIS,@PTFCIP Save 1st char in phrase GB352 DINC @PTCCIS Go on to next char * Got to watch for end of string. If encountered before a * #, act like char after string is #. Then last char will * be char before, or the last char in the string!! DCH @PTLCIS,@PTCCIS BS FNDNUM ST V*PTCCIS,@CCHAR No, get char in CCHAR CEQ NUMBER,@CCHAR If not # continue looking BR GB352 FNDNUM DST @PTCCIS,@PTLCIP Last char in phrase is one DDEC @PTLCIP before the # DINC @PTCCIS Point to char after # CALL GETTIM Get 1st timing char after phr CLR @SPLFLG Indicate don't spell BR GB38B No # as 1st char in phrase GB370 DST @PTCCIS,@PTFCIP Curr char is 1st char phrase CLR @SPLFLG Assume don't spell CHE >41,@CCHAR If not alphabetic (>41="A") BS GB37C INC @SPLFLG set spell flag * Need to find end of phrase, which is char before next * timing char we find. Therefore, look for a timing char! GB37C DINC @PTCCIS CALL GETTIM CEQ >FF,@TIMLEN If not timing, loop BS GB37C DST @PTCCIS,@PTLCIP Char before curr char is DDEC @PTLCIP the last char in phrase GB38B RTN *********************************************************** * TIMING will loop through chars in string until it finds * non-timing char. Non-timing chars have TIMLEN values of * >FE or >FF. GETTIM must be called before this routine to * establish a correct value of TIMLEN. Also, most likely * TOTTIM should have been cleared. *********************************************************** TIMING CHE >FE,@TIMLEN BS GB39B DADD @TIMLEN,@TOTTIM DINC @PTCCIS CALL GETTIM BR TIMING GB39B RTN *********************************************************** * GETTIM will examine the current char in the string and * set TIMLEN to the appropriate time delay value. TIMLEN * can take on the following values: * >00 if char is timing '+' * >06 if char is timing ' ' * >0C if char is timing '-' * >12 if char is timing ',' * >1E if char is timing ';' * >30 if char is timing ':' * >3C if char is timing '.' * >FE if char is out of stirng bounds * >FF if char is not timing * Note that to test timing, some manipulation of PTCCIS * would be neccesary, so it is stored and used in TEMP1 *********************************************************** GETTIM ST V*PTCCIS,@CCHAR Get the char DST @PTCCIS,@TEMP1 store curr ptr in TEMP1 DCH @PTLCIS,@TEMP1 out of string bounds? BR GB3AC ST >FE,@TIMLEN Yes, load value and return RTN GB3AC CH SEMICO,@CCHAR Can not be timing BS NOTIME CEQ SPACE,@CCHAR BR GB3C5 ST 6,@TIMLEN GB3B9 CEQ SPACE,V@1(@PTCCIS) While spaces BR GB3C4 DINC @PTCCIS Skip them BR GB3B9 GB3C4 RTN GB3C5 CEQ PLUS,@CCHAR BR GB3D4 DINC @TEMP1 Need to test the next char CALL NUMERC Is it numeric BS NOTIME Was numeric => not timing cha CLR @TIMLEN Not numeric => set as no timi RTN GB3D4 CEQ COMMAT,@CCHAR BR GB3DD ST >12,@TIMLEN RTN GB3DD CEQ PERIOD,@CCHAR BR GB3F4 DDEC @TEMP1 Go back to preceding char CALL NUMERC Is it numeric? BR PTIME No, so it is timing DINCT @TEMP1 Yes, on to following char CALL NUMERC Is it numeric too? BS NOTIME Yes, both numeric => not timi PTIME ST >3C,@TIMLEN Both not numeric => timing RTN GB3F4 CEQ HYPEN,@CCHAR BR GB404 DINC @TEMP1 Check next char CALL NUMERC Is it numeric? BS NOTIME Was numeric => not a timing c ST >0C,@TIMLEN Was not numeric => set as tim RTN GB404 CEQ COLON,@CCHAR BR GB40D ST >30,@TIMLEN RTN GB40D CEQ SEMICO,@CCHAR BR NOTIME ST >1E,@TIMLEN RTN NOTIME ST >FF,@TIMLEN Set as no timing char present RTN *********************************************************** * NUMERC tests the char pointed to by PTCCIS and verifies * the following: * 1 - it is within the current string boundaries * 2 - it is numeric (i.e. between '0' and '9') * If both of the above conditions are true, COND is set * upon return, otherwise COND is reset *********************************************************** NUMERC DCH @PTLCIS,@TEMP1 BS GB430 DCH @TEMP1,@PTFCIS BS GB430 CHE >30,V*TEMP1 BR GB430 CH >39,V*TEMP1 BR SETCB GB430 RTNC *********************************************************** * LOOKUP is a prolong routine to SEARCH. In each PHROM, * there may be 2 trees, one starting at >0000 and the other * at >8000. Either may or may not be present. Presences is * determined if a >AA byte is at the starting location. * LOOKUP determines if the tree at >0000 is in, and if so, * calls SEARCH with that addr. If that tree is not present * or the phrase couldn't be found in it, LOOKUP then checks * if the tree at >8000 is present, and again, if so, calls * SEARCH with that tree address. If the word was found in * the first tree, or after searching the second tree, the * routine will return. *********************************************************** LOOKUP DCLR @BYTE1 BYTE1 contains addr of curr t TRYAGN DST @BYTE1,@PTFBPH Look for >AA tree header CALL LOADAD LOADAD expects addr in PTFBPH ST >10,@>8300(@WRITE) Put out read byte command CEQ >AA,@>8300(@READ) Tree out there? BR GB44E DINC @PTFBPH Skip the tree header CALL SEARCH Go search this PHROM tree DCZ @DATAAD Phrase found => exit BR FOUND GB44E DADD >8000,@BYTE1 Go to start of next PHROM tre * Note >8000 + >8000 = >0000 => tried both trees DCZ @BYTE1 BR TRYAGN DCLR @DATAAD Didnt find phrase in either t FOUND RTN *********************************************************** * SEARCH actually searches the PHROM tree for the phrase. * The PHROM tree organization is as follows: * (i.e. this is one phrase node) * phrase ASCII length 1 byte * actual ASCII characters n bytes * less then pointer 2 bytes * greater then pointer 2 bytes * speech data pointer 3 bytes * speech data length 1 byte * The comparison of two words proceeds on a char by char * basis, where length is secondary to char values, i.e. * move > answer; number < we; eight < eighty; etc... *********************************************************** SEARCH CALL LOADAD Set PHROM to start phrase nod ST >10,@>8300(@WRITE) Issue read byte command CLR @PTLCPH Length of phrase => PTLCPH ST @>8300(@READ),@PTLCPH+1 (stored as 2 byte value DADD @PTFBPH,@PTLCPH Add front ptr giving end ptr DST @PTFBPH,@PTCCPH Set up curr char as 1 beyond DINC @PTCCPH length byte DST @PTFCIP,@PTCCIP Reset current ptr into phrase * Compare two characters NEXT ST >10,@>8300(@WRITE) Issue read byte command ST @>8300(@READ),@PHDATA Get char in from PHROM CEQ V*PTCCIP,@PHDATA Compare the char BR GB4D1 DINC @PTCCPH Equal, advance both pointers DINC @PTCCIP CEQ SPACE,V*PTCCIP Skip extra spaces BR GB4A1 GB48D CEQ SPACE,V@1(@PTCCIP) While spaces BR GB498 DINC @PTCCIP Skip them BR GB48D * By skipping extra spaces, might have reached end of phras * If this is true, next char in phrase = #. If so, advance * the pointer to be beyond end of phrase. GB498 CEQ NUMBER,V@1(@PTCCIP) BR GB4A1 DINC @PTCCIP GB4A1 DCH @PTLCPH,@PTCCPH End of PHROM word? BR GB4C6 DCH @PTLCIP,@PTCCIP Yes, end of phrase BR GB4C0 DST @PTLCPH,@PTFBPH Yes, word found * Skip 5 bytes down from last char to data pointer DADD 6,@PTFBPH CALL READAD Set data addr => DATAAD ST >10,@>8300(@WRITE) Issue read byte command ST @>8300(@READ),@STRLEN Get length of speech data RTN GB4C0 DST 3,@PTFBPH Move 3 bytes past PTLCPH BR NXTPHR GB4C6 DCH @PTLCIP,@PTCCIP 2 characters BR NEXT DST 1,@PTFBPH Phrase linger: use LT ptr BR NXTPHR * Two characters compared were not equal GB4D1 DST 3,@PTFBPH 3 bytes past last to GT CH V*PTCCIP,@PHDATA After phrase BR NXTPHR DDECT @PTFBPH Back up 2 bytes to LT link * Go get next phrase out of the PHROM to compare NXTPHR DADD @PTLCPH,@PTFBPH Add displacement to last char CALL READAD and get the new address DCZ @DATAAD More leaves on this tree BR GB4E8 RTN No, return empty handed GB4E8 DST @DATAAD,@PTFBPH Store new addr in PTFBPH BR SEARCH Go compare this new word! * The program should never reach this point!! It should * return somewhere up above. *********************************************************** * LOADAD will set the addr out in the PHROM to the addr * found in PTFBPH. Note that the PHROM is expecting five * nybbles to be written out as the address. *********************************************************** LOADAD DST @PTFBPH,@TEMP1 This is destructive, so copy DST @PTFBPH,@TEMP2 address into temporary areas SRL 4,@TEMP1 Isolate the MSN of the MSB SRL 4,@TEMP1+1 Isolate the MSN of the LSB DAND >0F0F,@TEMP2 Isolate the LSN of the MSB, L DOR >4040,@TEMP1 Include a 4 as MSN of all 4 n DOR >4040,@TEMP2 to indicate a Load Address C ST @TEMP2+1,@>8300(@WRITE) Write out the LSN of th ST @TEMP1+1,@>8300(@WRITE) Write out the LSN of th ST @TEMP2,@>8300(@WRITE) Write out the MSN of th ST @TEMP1,@>8300(@WRITE) Write out the MSN of th ST >40,@>8300(@WRITE) Write out 0 as fifth ny RTN *********************************************************** * READAD will read an address from the PHROM and store it * in DATAAD. Note that PTFBPH should contain the addr of * the PHROM location to be read so LOADAD will work. *********************************************************** READAD CALL LOADAD Set the addr of the PHROM ST >10,@>8300(@WRITE) Get high byte of addr ST @>8300(@READ),@DATAAD Stroe it in DATAAD ST >10,@>8300(@WRITE) Get low byte of addr ST @>8300(@READ),@DATAAD+1 Store it in DATAAD+1 RTN *********************************************************** * STDATA will store the data in DATAAD and TOTTIM onto the * speech list. It will also check that there is room on the * speech list for this entry, and abort with error if not. *********************************************************** STDATA DCEQ @PTEBSL,@PTLBSL Is there room? BS ERRSSL MOVE 3,@TOTTIM,V*PTLBSL Put data in list DADD 3,@PTLBSL and inc top of list RTN *********************************************************** * WAIT loops until the speech peripheral goes idle. *********************************************************** * ( Loop until nobody is talking) WAIT ST @>8300(@READ),@SPKSTS Read status from PHROM CLOG >80,@SPKSTS BR WAIT RTN *********************************************************** * SETRW moves addrs of speech read/write from GROM to VDP *********************************************************** SETRW MOVE 4,G@>0046,@READ RTN *********************************************************** * ERROR MESSAGES *********************************************************** * The following calls are in EXECS file. * ERRSYN CALL ERRZZ * SYNTAX ERROR * BYTE 3 * ERRSNM CALL ERRZZ * STRING-NUMBER MISMATCH * BYTE 7 * ERRBV CALL ERRZZ * BAD VALUE * BYTE 30 * ERRIAL CALL ERRZZ * INCORRECT ARGUMENT LIST * BYTE 31 *********************************************************** ERRSSL CALL ERRZZ * SPEECH STRING TOO LONG BYTE 21 *********************************************************** * RXB * GCHAR PATCH FOR COMMA GCHARA CEQ COMMAZ,@CHAT ,? BS GCHAR BR XPTRTN * MOTION PATCH for GO and STOP SPGS XML PGMCHR ( or , CEQ ALLZ,@CHAT ALL? BR SPGS1 No. XML PGMCHR Skip ALL XML PGMCHR Skip , DST 1,@FAC First sprite CALL SPNUM5 Get sprite table CALL SPMOVE Store velocity ST 28,@FAC Last sprite DCLR @VAR0 Index SPGSA MOVE 2,V@>0780,V@>0780(@VAR0) DADD 4,@VAR0 Index +4 DEC @FAC Sprite -1 BR SPGSA Done? B SPRMV4 No. SPGS1 CEQ NUMBEZ,@CHAT #? BR SPGS2 No. CALL SPNUM6 Standard routine. B SPRMV3 SPGS2 CEQ GOZ,@CHAT GO? BR SPGS3 No. AND >BF,@>83C2 GO!!! B SPGS4 Done. SPGS3 CEQ STOPZ,@CHAT STOP? BR ERRSYN No OR >40,@>83C2 STOP!!! SPGS4 XML PGMCHR Skip GO or STOP B SPRMV4 *********************************************************** * RXB ************************** SUBRTN RTN ************************** STRFCH XML PGMCHR XML PARSE BYTE >B6 RTN STRGET CALL STRFCH CEQ >65,@FAC2 BR ERRSNM * STRING NUM MISMATCH RTN NUMFCH CALL STRFCH CEQ >65,@FAC2 BS ERRSNM * STRING NUM MISMATCH RTN CFIFCH XML CFI CEQ >03,@FAC+10 BS ERRBV * NUMERIC OVERFLOW RTN GETNUM CALL SUBLP3 CEQ >B3,@CHAT BR ERRSYN RTN ROWCOL CALL GETNUM DCGT 24,@FAC BS ERRBV DDEC @FAC ST @XPT,@MNUM ST @FAC1,@YPT CALL GETNUM DCGT 32,@FAC BS ERRBV DDEC @FAC ST @FAC1,@XPT RTN NGOOD XML PGMCHR NGOOD1 CHE >80,@CHAT BS ERRSYN * ? CALL SNDER CEQ >65,@FAC2 BR ERRSNM * STRING NUMBER MISMATCH DST >001C,@FAC DST @SREF,@FAC4 DST @BYTES,@FAC6 BR SNDASS SNDER XML SYM XML SMB XML VPUSH RTN CIFSND XML CIF SNDASS XML ASSGNV RTN GETLP ST @CB,@VAR0 ST @CB,@VARV SUB OFFSET,@VARV ST @VARV,V@0(@STRPTR) DINC @STRPTR RTN PUTLP ST V@0(@FAC4),@VAR0 ADD OFFSET,@VAR0 DINC @FAC4 RTN HFMT FMT DATA >E000 FEND RTN VFMT FMT DATA >E000 BYTE >9E FEND RTN SUBLP3 CALL NUMFCH CALL CFIFCH RTN CLRFAC CLR @FAC MOVE 7,@FAC,@FAC1 RTN ************************** ERRFE CALL ERRZZ * BYTE 34 * DSKDSR DCHE 256,@VAR0 * BR DSRDSS * ADD >10,@>03C1 * DSRDSS DST >03C0,@FAC12 * CALL LINK * BYTE >0A * ST @>837C,@VAR2 * SRL 4,@FAC6 * CZ @FAC6 * BR ERRFE * CEQ >20,@VAR2 * BS ERRFE * RTN * *********************************************************** * RXB *********************************************************** ZKEY CALL KEY * KEY KEYAGN CEQ COMMAZ,@CHAT * BS ZKEY * BR LNKRTN * ************************** ZJOYST CALL JOYST * JOYST JOYAGN CEQ COMMAZ,@CHAT * BR LNKRTN * CALL CPAR2 * CALL GAC16 * BR JOYAGN * ***************************** SPAR CEQ LPARZ,@CHAT (? BS SPAR1 Yes. CEQ COMMAZ,@CHAT ,? BR ERRSYN No. SPAR1 XML PGMCHR Skip ( or , XML PARSE Get string or value. BYTE RPARZ CEQ >65,@FAC2 String? BR SPAR2 No. DST @FAC4,@>8304 Save address. DST @FAC6,@>8306 Save length. DST >994A,@>8310 Set flag. CALL LPAR RTN SPAR2 XML SPEED BYTE SYNCHK BYTE COMMAZ RTN ***************************** KEYSTR DCEQ >994A,@>8310 Flag set? BR RSCAN3 No. RSCAN SCAN Any key? BR RSCAN No. DCZ @>8306 Length 0? BS RSCAN4 Yes. DST @>8304,@>8308 String address. DST @>8306,@>8302 Copy length. RSCAN2 CEQ V*>8308,@RKEY Same? BS RSCAN5 Yes. DINC @>8308 Address +1 DDEC @>8302 Length -1 BR RSCAN2 No matcth. B RSCAN Restart. RSCAN3 SCAN Normal key scan. RSCAN4 CLR @KEYBD DCLR @>8310 Clear flag. RTNC RSCAN5 CALL RSCAN4 CEQ @0,@0 Force condition bit on. RTNC ***************************** CPAR2 XML SPEED * Similar to LPAR DATA COMMAZ * Syntax check , BR GAC35 * Parse value ***************************** ZSCOI CALL SPRCOI * COINC COINLP CEQ >B3,@CHAT * BR LNKRTN * XML PGMCHR * CALL GAF56 * BR COINLP * ************************** NR CALL PREPN * AR XML ASSGNV * RTN * ************************** ZSDIST CALL DIST * DISTANCE DISLP CEQ >B3,@CHAT * BR LNKRTN * CALL GAFC4 * BR DISLP * *********************************************************** LINKSD DATA LINKSE STRI 'GMOTION' DATA $+2 CALL SPNUM1 GMOTOIN GMAGN CALL SPNUM2 ST >02,@TEMP1 DST V@>0480(@SPSAL),@TEMP2 GMO1 CALL PREPN ST @TEMP2,@FAC+1 CH >7F,@FAC+1 BR GMO2 NEG @FAC+1 DNEG @FAC GMO2 CALL CIFSND CEQ >01,@TEMP1 BS GMO3 XML SPEED DATA >00B3 GMO3 EX @TEMP2,@TEMP2+1 DEC @TEMP1 BR GMO1 CEQ >B3,@CHAT BS GMAGN BR LNKRTN ************************** LINKSE DATA LINKSF STRI 'RMOTION' DATA $+2 CALL SPNUM1 * RMOTION RMAGN XML PGMCHR CEQ >EC,@CHAT BR NOALL XML SPEED DATA >00EC DST >001C,@VAR0 NXALL DST @VAR0,@FAC CALL SPNUM5 BR RMALL NOALL DST >0001,@VAR0 CEQ >FD,@CHAT BR ERRSYN CALL NUMFCH CALL SPNUM4 RMALL DST V@>0480(@SPSAL),@TEMP1 ST >02,@TEMP2 RMOTLP CZ @TEMP1 BS J2 CEQ >80,@TEMP1 BS J3 CH >7F,@TEMP1 BS J1 NEG @TEMP1 BR J2 J1 ABS @TEMP1 J2 EX @TEMP1,@TEMP1+1 DEC @TEMP2 BR RMOTLP DST @TEMP1,V@>0480(@SPSAL) J3 DDEC @VAR0 BR NXALL CEQ >B3,@CHAT BS RMAGN BR LNKRTN ***************************************** S1ET9F XML SPEED * CHECK FROM DATA >021E * 30 TO 159 DATA >009F * RTN * ***************************************** LINKSF DATA LINK10 STRI 'INVERSE' DATA $+2 CALL SPNUM1 INVERSE(CHAR#) INVAGN XML PGMCHR CEQ >EC,@CHAT BR INOALL XML SPEED DATA >00EC DST >001E,@FAC DSLL 3,@FAC DST >01C8,@TEMP1 BR INVLP INOALL XML PARSE BYTE >B6 CALL S1ET9F DSLL 3,@FAC DST >0004,@TEMP1 INVLP DINV V@>0300(@FAC) DADD >0002,@FAC DDEC @TEMP1 BR INVLP INVNOK CEQ >B3,@CHAT BS INVAGN BR LNKRTN ***************************************** SSDSLL CALL STRFCH CALL S1ET9F DSLL 3,@FAC RTN ***************************************** LINK10 DATA LINK11 STRI 'SWAPCHAR' DATA $+2 CALL SPNUM1 SWAPCHAR(CHAR#,CHAR#) SWCHAG CALL SSDSLL DST @FAC,@VAR4 CEQ >B3,@CHAT BR ERRSYN CALL SSDSLL DST @FAC,@VAR5 MOVE 8,V@>0300(@VAR4),@FAC MOVE 8,V@>0300(@VAR5),V@>0300(@VAR4) MOVE 8,@FAC,V@>0300(@VAR5) CEQ >B3,@CHAT BS SWCHAG BR LNKRTN ****************************************** LINK11 DATA LINK12 STRI 'DUPCHAR' DATA $+2 CALL SPNUM1 DUPCHAR(CHAR#,CHAR#) DCHAGN CALL SSDSLL DST @FAC,@VAR4 CEQ >B3,@CHAT BR ERRSYN CALL SSDSLL MOVE 8,V@>0300(@VAR4),V@>0300(@FAC) CEQ >B3,@CHAT BS DCHAGN BR LNKRTN ****************************************** S00T10 XML SPEED * CHECK FROM DATA >0200 * 0 TO 16 DATA >0010 * RTN * ****************************************** LINK12 DATA LINK13 STRI 'SWAPCOLOR' DATA $+2 XML SPEED SWAPCOLOR(SET#,SET#) DATA >00B7 SCOL10 CEQ >FD,@CHAT BR SCOL20 CALL SPNUM3 ST V@>0003(@FAC),@VAR4 DST @FAC,@VAR5 CEQ >FD,@CHAT BR ERRSYN CALL STRFCH CALL SPNUM4 ST V@>0003(@FAC),V@>0003(@VAR5) ST @VAR4,V@>0003(@FAC) CEQ >B3,@CHAT BR LNKRTN XML PGMCHR BR SCOL10 SCOL20 XML SPEED BYTE >01 CALL S00T10 DADD >080F,@FAC DST @FAC,@VAR4 XML PARSE BYTE >B6 CALL S00T10 DADD >080F,@FAC ST V*FAC,@VAR0 ST V*VAR4,V*FAC ST @VAR0,V*VAR4 CEQ >B3,@CHAT BR LNKRTN XML PGMCHR BR SCOL20 ****************************************** LINK13 DATA LINK14 STRI 'DUPCOLOR' DATA $+2 XML SPEED DUPCOLOR(SET#,SET#) DATA >00B7 DCOL10 CEQ >FD,@CHAT BR DCOL20 CALL SPNUM3 ST V@>0003(@FAC),@VAR4 CEQ >FD,@CHAT BR ERRSYN CALL STRFCH CALL SPNUM4 ST @VAR4,V@>0003(@FAC) CEQ >B3,@CHAT BR LNKRTN XML PGMCHR BR DCOL10 DCOL20 XML SPEED BYTE >01 CALL S00T10 DADD >080F,@FAC ST V*FAC,@VAR0 XML PARSE BYTE >B6 CALL S00T10 DADD >080F,@FAC ST @VAR0,V*FAC CEQ >B3,@CHAT BR LNKRTN XML PGMCHR BR DCOL20 ****************************************** LINK14 DATA LINK15 STRI 'LDIAG' DATA $+2 LDIAG CALL HVCHR LDIAG(R,C,CHAR#,REP) DCZ @FAC BS XPTRTN LLPD CALL VFMT DEC @XPT DDEC @FAC BS LCOMMA CZ @YPT BR LLPD DEC @XPT BR LLPD LCOMMA CEQ COMMAZ,@CHAT BS LDIAG BR XPTRTN ****************************************** LINK15 DATA LINK16 STRI 'RDIAG' DATA $+2 RDIAG CALL HVCHR RDIAG(R,C,CHAR#,REP) DCZ @FAC BS RCOMMA RLPD CALL VFMT INC @XPT DDEC @FAC BS RCOMMA CZ @YPT BR RLPD INC @XPT BR RLPD RCOMMA CEQ COMMAZ,@CHAT BS RDIAG BR XPTRTN ****************************************** LINK16 DATA LINK17 STRI 'MOVES' DATA $+2 CALL SPNUM1 MOVES(TYPE$,BYTES,$,TO) * or MOVES(TYPE$,BYTES,FROM,$) MOVESA CALL STRGET * ( or , DST V*FAC4,@VAR5 * TYPE "VRG" CALL GETNUM * ,BYTES DCZ @FAC BS ERRBV DST @FAC,@BYTES CALL STRFCH * ,FROM CEQ 36,@VAR5 BR MOVESX CHE @FAC6,@BYTES+1 BS MOVESB CLR @BYTES ST @FAC6,@BYTES+1 BR MOVESB MOVESX CALL CFIFCH DST @FAC,@FAC4 MOVESB DST @FAC4,@VARY CEQ 36,@VAR6 BR MOVESN DCHE 256,@BYTES BS ERRBV XML GETSTR CALL NGOOD DST @SREF,@FAC BR MOVESC MOVESN CALL SUBLP3 * ,TO MOVESC DST @FAC,@VARY2 CEQ 36,@VAR5 * VDP FROM BR MTYPES ST 86,@VAR5 MTYPES CEQ 36,@VAR6 BR MTYPE ST 86,@VAR6 MTYPE CEQ 86,@VAR5 * VDP FROM BR MTYPE3 CEQ 86,@VAR6 * VDP TO BR MTYPE1 MTYPE0 MOVE @BYTES,V@0(@VARY),V@0(@VARY2) MTYPE1 CEQ 82,@VAR6 * RAM TO BR MTYPE2 MOVE @BYTES,V@0(@VARY),@0(@VARY2) MTYPE2 CEQ 71,@VAR6 * GRAM TO BR MTYPE3 MOVE @BYTES,V@0(@VARY),G@0(@VARY2) MTYPE3 CEQ 82,@VAR5 * RAM FROM BR MTYPE7 CEQ 86,@VAR6 * VDP TO BR MTYPE5 MTYPE4 MOVE @BYTES,@0(@VARY),V@0(@VARY2) MTYPE5 CEQ 82,@VAR6 * RAM TO BR MTYPE6 MOVE @BYTES,@0(@VARY),@0(@VARY2) MTYPE6 CEQ 71,@VAR6 * GRAM TO BR MTYPE7 MOVE @BYTES,@0(@VARY),G@0(@VARY2) MTYPE7 CEQ 71,@VAR5 * GRAM FROM BR MOVESD CEQ 86,@VAR6 * VDP TO BR MTYPE9 MTYPE8 MOVE @BYTES,G@0(@VARY),V@0(@VARY2) MTYPE9 CEQ 82,@VAR6 * RAM TO BR MTYPEA MOVE @BYTES,G@0(@VARY),@0(@VARY2) MTYPEA CEQ 71,@VAR6 * GRAM TO BR MOVESD MOVE @BYTES,G@0(@VARY),G@0(@VARY2) MOVESD CEQ >B3,@CHAT BS MOVESA BR LNKRTN ******************************* LINK17 DATA LINK18 STRI 'HEX' HEX DATA $+2 CALL SPNUM1 HEXAGN CALL STRFCH Get STRING or NUMBER CEQ >65,@FAC2 STRING? BS HEXSTR Yes CALL CFIFCH No DST @FAC,@TEMP2 DST >0004,@BYTES XML GETSTR DST @SREF,@STRPTR ST @TEMP2,@VAR0 SRL 4,@VAR0 CALL HEXNS ST @TEMP2,@VAR0 SLL 4,@VAR0 SRL 4,@VAR0 CALL HEXNS ST @TEMP2+1,@VAR0 SRL 4,@VAR0 CALL HEXNS ST @TEMP2+1,@VAR0 SLL 4,@VAR0 SRL 4,@VAR0 CALL HEXNS CEQ COMMAZ,@CHAT BR ERRSYN CALL NGOOD BR HEXDON HEXNS CHE >0A,@VAR0 BR HEXNS2 ADD >07,@VAR0 HEXNS2 ADD >30,@VAR0 ST @VAR0,V*STRPTR DINC @STRPTR RTN HEXSTR DCLR @TEMP2 DST @FAC4,@STRPTR DCHE 5,@FAC6 BS HEXS4 CASE @FAC7 BR HEXS0 BR HEXS1 BR HEXS2 BR HEXS3 BR HEXS4 HEXS4 CALL HEXSN SLL 4,@VAR0 ADD @VAR0,@TEMP2 HEXS3 CALL HEXSN ADD @VAR0,@TEMP2 HEXS2 CALL HEXSN SLL 4,@VAR0 ADD @VAR0,@TEMP2+1 HEXS1 CALL HEXSN ADD @VAR0,@TEMP2+1 HEXS0 XML PGMCHR CALL SNDER CALL CLRFAC DST @TEMP2,@FAC CALL CIFSND HEXDON CEQ COMMAZ,@CHAT BS HEXAGN BR LNKRTN HEXSN ST V*STRPTR,@VAR0 CHE 103,@VAR0 * g ? BS ERRBA CHE 97,@VAR0 * a ? BR HEXSN2 SUB 32,@VAR0 * -32 HEXSN2 CHE 71,@VAR0 * G ? BS ERRBA CHE 65,@VAR0 * A ? BR HEXSN3 SUB 55,@VAR0 * -55 BR HEXSN4 HEXSN3 CHE 58,@VAR0 * : ? BS ERRBA CHE 48,@VAR0 * 0 ? BR ERRBA SUB 48,@VAR0 * -48 HEXSN4 DINC @STRPTR RTN ************************** LINK18 DATA LINK19 STRI 'IO' IO DATA $+2 CALL SPNUM1 IOAGN CALL GETNUM * TYPE 0-6 CHE >07,@FAC1 BS ERRBV ST @FAC1,@VARY CALL SUBLP3 * ADDRESS/ CASE @VARY * BITS/BYTES BR SOG BR SOV BR CRUI BR CRUO BR CSW BR CSR BR CSV SOG I/O 0,@FAC BR IODONE SOV I/O 1,@FAC BR IODONE CRUI CALL CRUSET I/O 2,@VAR4 XML PGMCHR CALL SNDER CALL CLRFAC ST @VAR0,@FAC1 CALL CIFSND * VARIABLE1 CHE >09,@VARY BS CRUI16 BR IODONE CRUI16 XML PGMCHR CALL SNDER CALL CLRFAC ST @VARV,@FAC1 CALL CIFSND * VARIABLE2 BR IODONE CRUO CALL CRUSET CALL SUBLP3 * VARIABLE1 DCHE >0100,@FAC BS ERRBV CHE >09,@VARY BS CRUO16 ST @FAC1,@VAR0 BR CRUO8 CRUO16 DST @FAC,@VAR0 CALL SUBLP3 * VARIABLE2 DCHE >0100,@FAC BS ERRBV ST @FAC1,@VARV CRUO8 I/O 3,@VAR4 BR IODONE CSW CALL CSLOAD I/O 4,@VAR4 BR IODONE CSR CALL CSLOAD I/O 5,@VAR4 BR IODONE CSV CALL CSLOAD I/O 6,@VAR4 IODONE CEQ >B3,@CHAT BS IOAGN BR LNKRTN CRUTMP DST @FAC,@VAR4 DCLR @VAR5 DCLR @VAR0 RTN CRUSET CZ @FAC1 BS ERRBV CHE >11,@FAC BS ERRBV ST @FAC1,@VARY CALL SUBLP3 * CRU-ADDRESS CALL CRUTMP ST @VARY,@VAR5 RTN CSLOAD CALL CRUTMP CALL SUBLP3 * ADDRESS DST @FAC,@VAR5 RTN ******************************* HVPNUM CLR @FAC11 Select XB FLP XML CNS CEQ SPACE,*FAC11 Leading space? BR HVPUTN INC @FAC11 Supress space out DEC @FAC12 Shorten length HVPUTN CLR @BYTES ST @FAC12,@BYTES+1 Length XML GETSTR MOVE @BYTES,*FAC11,V*SREF Store in VDP rollout DST @SREF,@FAC4 VDP rollout address DST @BYTES,@FAC6 Store length RTN ******************************* LINK19 DATA LINK1A STRI 'HPUT' DATA $+2 CALL SPNUM1 HPAGIN CALL ROWCOL Get ROW & COL CALL STRFCH Get string or number CEQ >65,@FAC2 String? BS HPUTS Yes CALL HVPNUM No, CNS HPUTS DCZ @FAC6 BS HPOUT DCLR @FAC HPUTLP CALL PUTLP CALL HFMT DDEC @FAC6 BR HPUTLP HPOUT CEQ >B3,@CHAT BS HPAGIN BR XPTRTN ************************** LINK1A DATA LINK1B STRI 'VPUT' DATA $+2 CALL SPNUM1 VPAGIN CALL ROWCOL Get ROW & COL CALL STRFCH Get string or number CEQ >65,@FAC2 String? BS VPUTS Yes CALL HVPNUM No, CNS VPUTS DCZ @FAC6 BS VPOUT DCLR @FAC VPUTLP CALL PUTLP CALL VFMT DDEC @FAC6 BS VPOUT CZ @YPT BR VPUTLP INC @XPT B VPUTLP VPOUT CEQ >B3,@CHAT BS VPAGIN BR XPTRTN **************************** HVGETS CALL ROWCOL CALL GETNUM DCGT >00FF,@FAC BS ERRBV * BAD VALUE DST @FAC,@BYTES DST @FAC,@TEMP1 XML GETSTR DST @SREF,@STRPTR RTN **************************** LINK1B DATA LINK1C STRI 'HGET' DATA $+2 CALL SPNUM1 HAGAIN CALL HVGETS LP2 CALL GETLP CALL HFMT DDEC @TEMP1 BR LP2 HDONE CALL NGOOD CEQ >B3,@CHAT BS HAGAIN BR XPTRTN ************************** LINK1C DATA LINK1D STRI 'VGET' DATA $+2 CALL SPNUM1 VAGAIN CALL HVGETS LP1 CALL GETLP CALL VFMT DDEC @TEMP1 BS VDONE CZ @YPT BR LP1 INC @XPT B LP1 VDONE CALL NGOOD CEQ >B3,@CHAT BS VAGAIN BR XPTRTN ******************************************************* * 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 * ******************************************************* LINK1D DATA LINK1E STRI 'EXECUTE' EXECUTE DATA $+2 CALL SPNUM1 EXAGN CALL SUBLP3 MOVE 12,@>8300,V@>03C0 MOVE 12,G@CPUPGM,@>8300 DST @FAC,@>8304 XML >F0 MOVE 12,V@>03C0,@>8300 CEQ >B3,@CHAT BS EXAGN BR LNKRTN *********************************************************** LINK1E DATA LINK1F STRI 'SIZE' SIZE DATA $+2 B SZSIZE LINK1F DATA LINK20 STRI 'CLSALL' CLSALL DATA $+2 CALL CLSALL BR LNKRT2 LINK20 DATA LINK21 STRI 'BYE' BYE DATA $+2 CALL CLSALL EXIT LINK21 DATA LINK22 STRI 'NEW' NEW DATA $+2 RXBNEW CLR V@>0371 Clear AUTOLOAD flag CALL CLSALL B SZNEW LINK22 DATA LINK23 STRI 'BIAS' BIAS DATA $+2 CALL SPNUM1 BIASAG CALL GETNUM DST @FAC,@VAR0 CALL STRGET DST @FAC4,@VARY DST @FAC6,@VARY2 BIASLP ST V*VARY,@FAC1 * Character. DCZ @VAR0 * 0? BS BIASM * Yes. ADD 96,@FAC1 * ADD OFFSET BR BIASSV BIASM SUB 96,@FAC1 * MINUS OFFSET BIASSV ST @FAC1,V*VARY DINC @VARY DDEC @VARY2 BR BIASLP CEQ >B3,@CHAT BS BIASAG BR LNKRTN LINK23 DATA LINK24 STRI 'EALR' EALR DATA $+2 CALL EASAVE BYTE >33 LINK24 DATA LINK25 STRI 'EAPGM' EAPGM DATA $+2 CALL EASAVE BYTE >35 LINK25 DATA LINK26 STRI 'EAED' EAED DATA $+2 XEAED CALL EASAVE BYTE >31 LINK26 DATA LINK27 STRI 'EA' EA menu DATA EAMENU EASAVE CALL SPNUM1 CALL STRGET ST @FAC,V@>2256 ADD 1,V@>2256 MOVE @FAC6,V@0(@FAC4),V@>2257 ST >0D,V@>2257(@FAC6) FETCH @CHAT EAMENU CALL CLSALL B GE025 LINK27 DATA LINK28 STRI 'XB' XB menu DATA $+2 XBMENU CALL CLSALL BR RXBRUN LINK28 DATA LINK29 STRI 'XBPGM' XBPGM DATA $+2 CALL SPNUM1 CALL CLSALL CALL STRGET DCZ @FAC6 BS RXBXBP CLR V@>2254 MOVE 50,V@>2254,V@>2255 DST >994A,V@>2254 ST @FAC7,V@>2256 MOVE @FAC6,V@0(@FAC4),V@>2257 RXBXBP CEQ >B3,@CHAT BR RXBRUN CALL RXBFIL RXBRUN B TOPLEV LINK29 DATA >C010 STRI 'FILES' FILES DATA $+2 CALL SPNUM1 CALL CLSALL CALL RXBFIL BR RXBNEW RXBFIL CALL SUBLP3 DCZ @FAC BS ERRBV DCHE 16,@FAC BS ERRBV CEQ RPARZ,@CHAT BR ERRSYN XML PGMCHR DCLR @FAC2 ST @FAC1,@FAC2 DST >0116,V@>03C0 CALL DSKDSR RTN ******************************************************************************** END Spoiler *********************************************************** TITL 'MYXB6' *********************************************************** GROM >C000 *********************************************************** TITL 'EQUATES ALCS-359' *********************************************************** FSLOC EQU >2002 Free Start LOCation in ERAM * Free end must follow it. 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 CHRTBL EQU >6018 RXB CALL CHRTBL load char set MZMSG EQU >6038 Start of message area MZSUB EQU >AE00 Module SPRITE branch table ad *********************************************************** 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 >63A5 RXB PATCH for NEW TOPL15 EQU >63DD * Return from OLD or SAVE TOPL42 EQU >6433 TOPL55 EQU >6462 ILLST EQU >64EF SZSIZE EQU >65C9 RXB PATCH for SIZE EDITLN EQU >66CF * Edit a line into a program READL3 EQU >6A8A G6D78 EQU >6D78 * GKXB ERR routine ERPRNT EQU >6E0E ERPNT5 EQU >6E1B DISO EQU >6FBA GRMLST EQU >802A ALCEND EQU >9800 RXB moved INIT here ASC EQU >A00A LNKRTN EQU >A01C GE025 EQU >E025 RXB PATCH for EA *********************************************************** * EQUATES FOR ROUTINES FROM OTHER GROM SECTIONS INITPG EQU >6014 Initialize program space SPRINT EQU >6016 Initialize sprites TOPL10 EQU >601A Return to main and re-init CHRTAB EQU >601C Load default character set SZRUN EQU >601E KILSYM EQU >6022 KILL SYMBOL TABLE ROUTINE AUTO1 EQU >602E Get arguments for LIST comman TOPL02 EQU >6030 RTN address for failing AUTOL GRSUB1 EQU >6034 Read data (2 bytes) from ERAM GWSUB EQU >6036 Write a few bytes of data to MSGBRK EQU >6048 * BREAKPOINT MSGTA EQU >6053 Message "try again" LLIST EQU >6A74 List a line READLN EQU >6A76 Read a line from keyboard CHKEND EQU >6A78 Check end of statement ENTER EQU >6A7E ENT09 EQU >6A80 WARNZZ EQU >6A82 WARNING MESSAGE ROUTINE ERRZZ EQU >6A84 ERROR MESSAGE ROUTINE ERRZ EQU >6A84 ERRor routine READL1 EQU >6A86 Read a line from keyboard DISPL1 EQU >8000 DELET EQU >8002 PRINT EQU >8004 INPUT EQU >8006 OPEN EQU >8008 CLOSE EQU >800A RESTOR EQU >800C NREAD EQU >800E CLSALL EQU >8012 EOF EQU >801C ACCEPT EQU >801E SRDATA EQU >8020 REC EQU >8022 GRSUB2 EQU >802C GRSUB3 EQU >802E LINPUT EQU >8030 CONVER EQU >A012 CONVERT WITH WARNING CPL EQU >0010 Call Program Link RPL EQU >0012 Return Program Link GRINT EQU >0022 Greatest integer ATNZZ EQU >0032 Arctangent routine *********************************************************** * Equates for routine in MONITOR DSR EQU >10 CALL DEVICE SERVICE ROUTINE TONE1 EQU >34 ACCEPT TONE TONE2 EQU >36 BAD TONE CHAR2Z EQU >18 CHARACTER TABLE ADDRESS small CHAR3Z EQU >4A CHARACTER TABLE ADDRESS *********************************************************** * Equates for XMLs SYNCHK EQU >00 SYNCHK XML selector FILSPC EQU >01 Fill-space utility PARCOM EQU >01 PARse to a COMma selector CSTRIN EQU >02 Copy-string utility RANGE EQU >02 RANGE selector SEETWO EQU >03 SEETWO XML selector FADD EQU >06 Floating ADD FMUL EQU >08 Floating MULtiply FDIV EQU >09 Floating DIVide FCOMP EQU >0A Floating COMPare SADD EQU >0B Stack ADD SSUB EQU >0C Stack SUBtract CSNUM EQU >10 Convert String to Number CFI EQU >12 Convert to two byte integer FLTINT EQU >12 Convert floating to integer ALSUP EQU >20 XML to user AssembLy SUBrouti COMPCT EQU >70 PREFORM A GARBAGE COLLECTION GETSTR EQU >71 SYSTEM GET STRING MEMCHK EQU >72 MEMORY check routine: VDP CNS EQU >73 Convert number to string * Warning Defualt changed in >0159 PARSE EQU >74 Parse a value CONT EQU >75 Continue parsing EXECG EQU >76 Execute a XB stmt or program 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 SCHSYM EQU >7D Search symbol table SPEED EQU >7E SPEED UP XML CRUNCH EQU >7F Crunch an input line CIF EQU >80 Convert INTEGER to FLOATING P RTNB EQU >82 Return SCROLL EQU >83 SCROLL THE SCREEN IO EQU >84 IO utility (KW table search) GREAD EQU >85 READ DATA FROM ERAM GWRITE EQU >86 WRITE DATA TO ERAM DELREP EQU >87 REMOVE CONTENT FROM VDP/ERAM MVDN EQU >88 MOVE DATA IN VDP/ERAM MVUP EQU >89 MOVE DATA IN VDP/ERAM VGWITE EQU >8A MOVE DATA FROM VDP TO ERAM GVWITE EQU >8B WRITE DATA FROM GRAM TO VRAM GREAD1 EQU >8C READ DATA FROM ERAM GDTECT EQU >8E ERAM DETECT&ROM PAGE 1 ENABLE SCNSMT EQU >8F SCAN STATEMENT FOR PRESCAN *********************************************************** * Temporary workspaces in EDIT CPUOFF EQU >8300 CPU RAM OFFSET VAR0 EQU >8300 TEMPORARY SP00 EQU >8300 SPRITE value PTFBSL EQU >8300 Ptr to 1st byte in SPEAK list PHLEN EQU >8300 PHrom data LENgth VARV EQU >8301 TEMPORARY PHRADD EQU >8301 PHRom ADDress ACCUM EQU >8302 # OF BYTES ACCUMULATOR (4 BYTE STPT EQU >8302 TWO BYTES MNUM EQU >8302 Ussually a counter AAA1 EQU >8302 SP02 EQU >8302 SPRITE value PTLBSL EQU >8302 Ptr to last byte in SPEAK list CHKSUM EQU >8302 Check sum word PC EQU >8304 Address in ERAM to load next v VARY EQU >8304 PABPTR EQU >8304 Pointer to current PAB SP04 EQU >8304 SPRITE value PTEBSL EQU >8304 Ptr to end byte in SPEAK list * NOTE: PTEBSL points to the end of the temporary speak lis * whereas PTLBSL points to the last byte actually use * i.e. PTFBSL <= PTLBSL <= PTEBSL VARY2 EQU >8306 Use in MVDN only DFLTLM EQU >8306 Default array limit (10) CCPPTR EQU >8306 OFFSET WITHIN RECORED (1) * or Pointer to current column SP06 EQU >8306 SPRITE value PTFCIS EQU >8306 Ptr to 1st character in string OFFADD EQU >8306 OFFADD of relocatable programs * loaded into ERAM. RECLEN EQU >8307 LENGTH OF CURRENT RECORD (1) CCPADR EQU >8308 RAM address of current refs * or Actual buffer address or c VARC EQU >8308 CCPADD EQU >8308 RAM address of current color CCC1 EQU >8308 SPSAL EQU >8308 Location of sprite attribute l PTCCIS EQU >8308 Ptr to current character in st 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!!!) CALIST EQU >830A Call list for resolving refs RAMPTR EQU >830A Pointer for crunching STADDR EQU >830A Start address - usually for co SPTMP EQU >830A Temporary variable PTLCIS EQU >830A Ptr to last character in strin VAR2 EQU >830B BYTES EQU >830C BYTE COUNTER * or String length for GETSTR NMPTR EQU >830C Pointer save for pscan BBB1 EQU >830C PTFCIP EQU >830C Ptr to 1st character in phrase BUFPNT EQU >830E I/O buffer pointer CHSAV EQU >830E CURINC EQU >830E Increment for auto-num mode VAR4 EQU >830E PTCCIP EQU >830E Ptr to current character in ph TOPSTK EQU >8310 Top of data stack pointer VAR5 EQU >8310 VAR5 through VAR5+3 used in RA PTLCIP EQU >8310 Ptr to last character in phras 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 LINUM EQU >8312 Used to determine end of scan PTFBPH EQU >8312 Ptr to 1st byte in PHrom VAR7 EQU >8312 Used in CHARLY COUNT EQU >8312 FLAG BITS STRPTR EQU >8312 String pointer (CHARPAT) NMLEN EQU >8314 Current line for auto-num CURLIN EQU >8314 Current line for auto-num * or Starting line number for L PTCCPH EQU >8314 Ptr to current byte in PHrom 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 XFLAG EQU >8316 SCAN FLAG-BITS USED AS BELOW PTLCPH EQU >8316 Ptr to last byte in PHrom TEMP EQU >8316 FLAG BITS DFLAG EQU >8316 Disk/Hard FLAG DEVNUM EQU >8317 DEVice NUMber for Hard drive DSRFLG EQU >8317 INTERNAL =60, EXTERNAL =0 (1) OPTFLG EQU >8317 Option flag byte during OPEN FORNET EQU >8317 Nesting level of for/next FNUM EQU >8317 Current file number for search *********************************************************** * Permanent workspace variables STRSP EQU >8318 String space begining STREND EQU >831A String space ending SREF EQU >831C Temporary string pointer SMTSRT EQU >831E Start of current statement VARW EQU >8320 Screen address (CURSOR) ERRCOD EQU >8322 Return error code from ALC STVSPT EQU >8324 Value-stack base RTNG EQU >8326 Return vector from 9900 code NUDTAB EQU >8328 Start of NUD table 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 DATA EQU >8334 Data pointer for READ LNBUF EQU >8336 Line table pointer for READ INTRIN EQU >8338 Add of intrinsic poly constant SUBTAB EQU >833A Subprogram symbol table IOSTRT EQU >833C PAB list/Start of I/O chain SYMTAB EQU >833E Symbol table pointer FREPTR EQU >8340 Free space pointer CHAT EQU >8342 Current charater/token BASE EQU >8343 OPTION BASE value PRGFLG EQU >8344 Program/imperative flag FLAG EQU >8345 General 8-bit flag BUFLEV EQU >8346 Crunch-buffer destruction leve LSUBP EQU >8348 Last subprogram block on stack * FAC EQU >834A Floating-point ACcurmulator CCHAR EQU >834A Current character FAC1 EQU FAC+1 SPLFLG EQU >834B SPelL out phrase FLaG FAC2 EQU FAC+2 AAA EQU FAC+2 TOTTIM EQU >834C TOTal wait TIMe * NOTE: DATAD must follow immediately after TOTTIM. The * routine STDATA is counting on this fact! FAC3 EQU FAC+3 DATAAD EQU >834D Speech DATA ADdress FAC4 EQU FAC+4 CCC EQU FAC+4 FFF EQU FAC+4 FAC5 EQU FAC+5 PTLCIL EQU >834F Pointer To Last Character In L FAC6 EQU FAC+6 BBB EQU FAC+6 EEE EQU FAC+6 FAC7 EQU FAC+7 TIMLEN EQU >8351 TIMe LENgth of timing charact FAC8 EQU FAC+8 PHADDR EQU >8352 PHrom ADDRess FAC9 EQU FAC+9 FAC10 EQU FAC+10 DDD1 EQU FAC+10 TEMP1 EQU >8354 TEMPorary CPU location 1 FAC11 EQU FAC+11 FAC12 EQU FAC+12 FFF1 EQU FAC+12 TEMP2 EQU >8356 TEMPorary CPU location 2 FAC13 EQU FAC+13 FAC14 EQU FAC+14 EEE1 EQU FAC+14 READ EQU >8358 Address of speech peripheral * READ byte interface FAC15 EQU FAC+15 FAC16 EQU FAC+16 WRITE EQU >835A Address of speech peripheral * WRITE byte interface FAC17 EQU FAC+17 * ARG EQU >835C Floating-point ARGument ARG1 EQU ARG+1 PHDATA EQU >835D PHrom DATA ARG2 EQU ARG+2 PTCBED EQU >835E Ptr To Current Byte Ext Data INDEX EQU >835E Label or program ID - 8 bytes ARG3 EQU ARG+3 ARG4 EQU ARG+4 LENCST EQU >8360 LEN of Current ext data STring ARG5 EQU ARG+5 ARG6 EQU ARG+6 LENWST EQU >8362 LEN of Whole ext data STring STRLEN EQU >8364 STRing LENgth TEMP4 EQU >8364 TEMP5 EQU >8366 * NOTE: BYTE1, BYTE2, and BYTE3 must be in consecutive memo * locations, and in the following order for SPGET to * work! BYTE1 EQU >8366 BYTE 1 BYTE2 EQU >8367 BYTE 2 BYTE3 EQU >8368 BYTE 3 TEMP6 EQU >8368 SPKSTS EQU >8369 SPeaK StaTus FPERAD EQU >836C Value stack pointer * VSPTR EQU >836E Value stack pointer *********************************************************** * GPL Status Block STACK EQU >8372 STACK FOR DATA SUBSTK EQU >8373 SUBROUTINE STACK KEYBD EQU >8374 KEYBOARD SELCTION RKEY EQU >8375 KEY CODE SIGNZ EQU >8375 EXPZ EQU >8376 Exponent in floating-point JOYY EQU >8376 JOYSTICK Y POSITION JOYX EQU >8377 JOYSTICK X POSITION RANDOM EQU >8378 RANDOM NUMBER GENERATOR TIMER EQU >8379 TIMING REGISTER MOTION EQU >837A NUMBER OF MOVING SPRITES VDPSTS EQU >837B VDP STATUS REGISTER VDPSTT EQU >837B VDP STATUS REGISTER ERCODE EQU >837C STATUS REGISTER CB EQU >837D Character Buffer *********************************************************** RAMTOP EQU >8384 Highest address in ERAM * = 0 if ERAM not present RAMFRE EQU >8386 Free pointer in the ERAM RSTK EQU >8388 Subroutine stack base * (Starts at >8A) RAMFLG EQU >8389 ERAM flag GRAMFL EQU >8389 GRAM / VDP flag STKMIN EQU >83AF Base of data stack STKMAX EQU >83BD Top of data stack GKFLAG EQU >83C2 GKXB flag for PEEK/LOAD VDP/GR PRTNFN EQU >83CE Sound - previous tone finished *********************************************************** * VDP addresses SCRNBS EQU >02E0 Screen base addr for last lin NLNADD EQU >02E2 New LiNe ADDress ENDSCR EQU >02FE END of SCReen address SPRSAL EQU >0300 Sprite attribute list LODFLG EQU >0371 Auto-boot needed flag START EQU >0372 Line to start execution at * Temporary NOTONE EQU >0374 NO-TONE for SIZE in ACCEPT us * in FLMGRS (4 bytes used) SYMBOL EQU >0376 Saved symbol table pointer ONECHR EQU >0378 Used for CHRZ VRMSND EQU >0379 Sound blocks SPGMPT EQU >0382 Saved PGMPTR for continue SBUFLV EQU >0384 Saved BUFLEV for contiue SEXTRM EQU >0386 Saved EXTRAM for continue SAVEVP EQU >0388 Saved VSPRT for continue ERRLN EQU >038A On-error line pointer BUFSRT EQU >038C Edit recall start addr (VARW) BUFEND EQU >038E Edit recall end addr (VARA) CSNTMP EQU >0390 Use as temporary stored place * or CSN TEMPORARY FOR FAC12 TABSAV EQU >0392 Saved main symbol table ponte AUTTMP EQU >0394 AUTOLD TEMPORARY IN SIDE ERRZ SLSUBP EQU >0396 Saved LSUBP for continue SFLAG EQU >0398 Saved on-warning/break bits SSTEMP EQU >039A To save subprogram program ta SSTMP2 EQU >039C Same as above. Used in SUBPRO MRGPAB EQU >039E MERGEd temporary for pab ptr RNDX2 EQU >03A0 Random number generator seed RNDX1 EQU >03A5 Random number generator seed INPUTP EQU >03AA INPUT TEMPORARY FOR PTR TO PR SPNUM EQU >03AA Sprite number temporary, also * in INPUTP in FLMGR ACCVRW EQU >03AC Temoporary used in ERRZZ, als * used in FLMGRS * or temporary for @VARW, @VARA ACCVRA EQU >03AE TRY AGAIN VALIDP EQU >03B0 Use as two values passing fro * or PTR TO STANDARD STRING IN VAL VALIDL EQU >03B2 VALIDATE code to READL1 * or Length of string in validate SIZCCP EQU >03B4 SIZE TEMPORARY FOR CCPADR SIZREC EQU >03B6 SIZE TEMPORARY FOR RECLEN * Also used as temporary in RELO *---------------------------------------------------------- * Added 6/8/81 for NOPSCAN feature PSCFG EQU >03B7 *---------------------------------------------------------- ACCTRY EQU >03B7 ACCEPT "TRY AGAIN" FLAG SIZXPT EQU >03B8 Save XPT in SIZE when "try ag SAPROT EQU >03B9 PROTECTION flag in SAVE CSNTP1 EQU >03BA CSN TEMPORARY FOR FAC10 *---------------------------------------------------------- * Flag 0: 99/4 console, 5/29/81 * 1: 99/4A console CONFLG EQU >03BB *---------------------------------------------------------- OLDTOP EQU >03BC Temporary used in ERRZZ, also * or Old top of memory for RELOCA CPTEMP EQU >03BC CCPPTR, RECLEN temp in INPUT NEWTOP EQU >03BE New top of memory for RELOCA VROAZ EQU >03C0 Temporary roll-out area SPRVB EQU >0780 Sprite velocity block. CRNBUF EQU >0820 CRuNch BUFfer address CRNEND EQU >08BE CRuNch buffer END RECBUF EQU >08C0 Edit RECall BUFfer VRAMVS EQU >0958 Default base of value stack *********************************************************** * IMMEDITATE VALUES NUMBR EQU >00 NUMERIC validate LISTZ EQU >02 X2 EQU >03 OLDZ EQU >05 RESEQZ EQU >06 SAVEZ EQU >07 MERGEZ EQU >08 DWNARR EQU >0A UPARR EQU >0B CHRTN EQU >0D BKGD EQU >20 BACKGROUND CHARACTER OFFSET EQU >60 OFFSET FOR VIDEO TABLES STRVAL EQU >65 Value in accum. is string val STRING EQU >65 String ID # for FAC *********************************************************** * Editting command equates & keys or symbols BREAK EQU >02 Break key DLETE EQU >03 Delete key INSRT EQU >04 Insert key RECALL EQU >06 Edit-buffer recall CLRLN EQU >07 Clear-line key BACK EQU >08 Back-space key FORW EQU >09 Forward-space key DOWN EQU >0A Down-arrow key UPMV EQU >0B Up-arrow key VWIDTH EQU >1C Screen width (PRINT) SPACE EQU >20 Space key QUOTE EQU >22 " NUMBER EQU >23 # DOLLAR EQU >24 $ CURSOR EQU >1E+OFFSET CURSOR EDGECH EQU >1F+OFFSET EDGE character PLUS EQU >2B + COMMAT EQU >2C , MINUS EQU >2D - HYPEN EQU >2D + PERIOD EQU >2E . ZERO EQU >30 0 NINE EQU >39 9 COLON EQU >3A : SEMICO EQU >3B ; LESS EQU >3C < GREAT EQU >3E > A EQU >41 A F EQU >46 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 RNM EQU 6 RECORD NUMBER 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 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 >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 *********************************************************** * 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. * * 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) *********************************************************** ******************* LINKAGE AND HEADER ******************** BYTE >AA BYTE 0,0,0 BYTE 0,0,0,0,0,0 DATA 0 BYTE 0,0,0,0 LINK1 DATA LINK2 STRI 'LINK' DATA LINKIT LINK2 DATA LINK3 STRI 'LOAD' DATA LOAD LINK3 DATA LINK4 STRI 'INIT' DATA INIT * GKXB new entry point for PEEK LINK4 DATA LINK5 STRI 'PEEK' DATA GKPEEK * GKXB new subprograms LINK5 DATA QTON 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 LOAD DST >0001,@CHKSUM {INITIALIZE FILE FLAG} * GKXB Change load routine. Delete check for INIT * add to clear flag bits. CALL GKLOAD GC047 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 * ????????????????????????????????????????????????????????? AORG >0088 * 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,@VAR0 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,@VAR0 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,@VAR0 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,@VAR0 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,@VAR0 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 RPL Return to caller ********************** CHKIN ****************************** * Check for INIT-FLAG = >AA55 * MOVE ERAM(INITF) to CPU *FAC PAGE EQU $ CHKIN DST FAC,@VAR0 Destination DST INITF,@VARB Source DST 2,@ARG 2 bytes XML MVUP Move it DCEQ >AA55,@FAC Syntax error BR ERRSYN * No files have been opened so if there is a syntax error * goto ERRSYN! RTN *********************** 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) CLR V*SREF Clear the entire PAB MOVE PABLEN-1,V*SREF,V@1(@SREF) 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 DSR 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 DSR CALL DSR through program link BYTE 8 * "8" is type of DSR GC2B9 RTN *********************************************************** * INIT JDH 9/02/80 *********************************************************** * 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. MOVE >04EA,G@ALCEND,@>2000 B LDRET2 *********************************************************** * PEEK INSTRUCTION JDH 9/04/80 *********************************************************** * * FORMAT: * CALL PEEK open address (comma numeric-variable) * close * FUNCTION: * RETURNS THE VALUE AT address IN ERAM INTO numeric-variab * 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 * ????????????????????????????????????????????????????????? AORG >0308 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 "(" CALL CHKEND BR ERRSYN CALL RPL 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 program *********************************************************** 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 *********************************************************** * SUBROUTINES used in this file. *********************************************************** CLRFAC CLR @FAC MOVE 7,@FAC,@FAC1 RTN *********************************************************** * CHARPAT ROUTINE 99/4A - JDH 10/01/80 *********************************************************** * * FORMAT: * CALL CHARPAT open (numeric expression, string expression * * FUNCTION: * RETURNS THE CHARACTER DEFINITION PATTERN FOR CHARACTER * NUMBER <numeric expression> INTO <string expression> * ******************* GETCHR - GETCHR2*********************** GETCHR CEQ LPARZ,@CHAT BR ERRSYN GCHR2 XML PGMCHR XML PARSE BYTE RPARZ CEQ STRING,@FAC2 Can't be a string BS ERRSNM XML CFI Convert FAC to integer CEQ 3,@FAC10 Range 32 to 143 BS ERRBA DCGE 30,@FAC 30 BR ERRBA DCGT 159,@FAC 159 BS ERRBA DSLL 3,@FAC 8 bytes / entry so times 8 DST >0300,@TBLPTR Base of char table less 32*8 DADD @FAC,@TBLPTR Add in arg offset DST 16,@BYTES 16 byte string in string spac XML GETSTR DST @SREF,@STRPTR Save pointer to string ST 8,@INDEXC Loop counter GC46D ST V*TBLPTR,V*STRPTR SRL 4,V*STRPTR Get rid of low nibble ADD >30,V*STRPTR Add ASCII "0" CGT >39,V*STRPTR >39 = ASCII "9" BR GCHR3 ADD 7,V*STRPTR Value "A" to "F" GCHR3 DINC @STRPTR ST V*TBLPTR,V*STRPTR AND >0F,V*STRPTR ADD >30,V*STRPTR Add ASCII "0" CGT >39,V*STRPTR BR GCHR4 ADD 7,V*STRPTR Value "A" to "F" GCHR4 DINC @TBLPTR DINC @STRPTR DEC @INDEXC CZ @INDEXC BR GC46D * NOW assign the string just created to the string * variable following XML PGMCHR Skip comma * The following check has been put in SYM, 5/26/81 * If CHAT >= >80 then ERRSYN (Do not allow token). XML SYM Get symbol table info for next ar XML SMB XML VPUSH Save on stack for ASSGNV CEQ STRING,@FAC2 Must be a stirng variable BR ERRSNM 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 CEQ COMMAZ,@CHAT BS GCHR2 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 move INIT code to >9800 *********************************************************** * * CALL QUITON routine * QTON DATA QTOFF STRI 'QUITON' DATA QTON1 QTON1 AND >EF,@GKFLAG Reset QUIT bit B LDRET2 Return * * CALL QUITOFF routine * QTOFF DATA POKEV STRI 'QUITOFF' DATA QTOFF1 QTOFF1 OR >10,@GKFLAG Set QUIT bit BR LDRET2 Return * * Set-up for CALL GKLOAD routine * GKLOAD AND >F0,@GKFLAG Reset flag bits RTN Return * * POKEV routine * POKEV DATA PEEKV STRI 'POKEV' DATA POV POV CALL GKSETV Set VDP bit DST 1,@CHKSUM For GKLOAD routine B GC047 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 * * PEEKV routine * 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 * * PEEKG routine * PEEKG DATA POKEG STRI 'PEEKG' DATA PKG PKG CALL GKSETG Set flag bit B PEEK Use PEEK routine * * POKEG routine * POKEG DATA CATLOG STRI 'POKEG' DATA POG POG CALL GKSETG Set flag bit DST 1,@CHKSUM For LOAD routine B GC047 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 *********************************************************** * * Disk catalog routine * CATLOG DATA POKER STRI 'CAT' CALL CAT(path) 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 GLPARZ 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 150,@BYTES Length of CAT PAB use XML GETSTR Get some string space MOVE 150,V@>08C0,V*SREF Save USER PAB area MOVE 9,G@GKPABD,V@>08C0 Install PAB ST @FAC7,V@>08C9 MOVE @VARB,V*FAC4,V@>08CA * * Open Device * CALL GKDSRL Link to device * * Read first record * DST >020D,V@>08C0 Make PAB a read GKCAT2 CALL GKDSRL Link to device * ST >B9,@AAA1 Y with offset CALL GKSCRN Set up header CLR @VARV 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 ')' CALL CHKEND SYNTAX error if not end BR ERRSYN . CALL RPL Return to X-BASIC * * File error * GKERR DST >08C0-4,@PABPTR Fake a BASIC PAB DST V@>08C0,@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@>08C0 A close operation CALL GKDSR Link to device MOVE 150,V*SREF,V@>08C0 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 2 COL 2 HTEX 'Free= Used=' ROW 22 COL 3 HTEX 'Filename Size Type P' ROW+ 1 COL 2 HTEX '---------- ---- ----------- -' FEND CALL GKDSTR Get string into FAC CZ @FAC+1 Skip if zero length BS GKCAT3 FMT SCRO >60 ROW 1 COL 13 HSTR 10,@FAC+2 FEND GKCAT3 DADD @FAC,@VAR5 Go to next field DADD 19,@VAR5 Continue to last field DST 73,@VAR9 Set up screen addr CALL GKDNUM Display available space * Display used space DSUB 9,@VAR5 Point to formatted space MOVE 8,V*VAR5,@ARG Move it to ARG XML FSUB Develop used value DST 88,@VAR9 Set up screen addr CALL GKDNU1 Display used space 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 @VAR0 Clear a byte CZ @VAR0 Set COND bit RTNC Return w/COND * * Scroll the screen * GKSCRL CH 18,@VARV Check line counter BS GKSCL1 Short scroll INC @VARV Line count +1 MOVE >280,V@>80,V@>60 Scroll screen GKSCL2 ST SPACE,V@>2E0 Clear last line ADD >60,V@>2E0 MOVE >1F,V@>2E0,V@>2E1 RTN Return GKSCL1 MOVE >240,V@>C0,V@>A0 BR GKSCL2 * * Display one file on screen * GKFNAM CALL GKDSTR Get string into FAC CZ @FAC+1 Skip display if zero BS GKCAT5 length FMT SCRO >60 Put disk name on screen ROW 23 . COL 02 . HSTR 10,@FAC+2 . 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 >2EA,@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 @FAC+1 Adjust for CASE CASE @FAC+1 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 >2F6,@VAR9 Set up screen address CALL GKDNUM Display record length RTN Return GKFNA1 CLR @VAR0 Clear a byte CZ @VAR0 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 @FAC+11 Indicate a free format XML CNS Convert FAC to a string DST 7,@VARB Right justify number SUB @FAC+12,@VARB+1 DADD @VARB,@VAR9 GKDNU2 ADD >60,*FAC+11 Add offset to string ST *FAC+11,V*VAR9 Put a char on the screen DINC @VAR9 Increment screen addr. INC @FAC+11 Increment FAC addr. DEC @FAC+12 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) * FAC+2 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,@FAC+1 Store disk name length DINC @VAR5 Point to string ST >20,@FAC+2 Clear out string space MOVE 9,@FAC+2,@FAC+3 . MOVE @FAC,V*VAR5,@FAC+2 Move disk name into FAC RTN *********************************************************** 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 MO TEXT 'IF' BYTE IFZ * IF TEXT 'ON' BYTE ONZ * ON 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 'LET' BYTE LETZ * LET TEXT 'LOG' BYTE LOGZ * LOG TEXT 'MAX' BYTE MAXZ * MAX TEXT 'MIN' BYTE MINZ * MIN TEXT 'NEW' BYTE >00 * NEW TEXT 'NOT' BYTE NOTZ * NOT TEXT 'NUM' BYTE >04 * NUMber TEXT 'OLD' BYTE >05 * OLD 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 TEXT 'RUN' BYTE RUNZ * RUN 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 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 TEXT 'SEG$' BYTE SEGZZ * SEG$ TEXT 'SIZE' BYTE SIZEZ * SIZE TEXT 'STEP' BYTE STEPZ * STEP TEXT 'STOP' BYTE STOPZ * STOP <<<< RXB MOT 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 >0D76 BYTE >00 * RXB patch to even out addre *********************************************************** * 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 *********************************************************** 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 FOR USER **** * GD0C6 MOVE @FAC,V*VARW,V@RECBUF Save line GD0C6 MOVE @FAC,V*VARW,V*VARW 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 *********************************************************** * RXB ******************************************************* * AMS BRANCH TABLE FOR AMS ROUTINES * FIXED * BR AMSMAP * AT * BR AMSPAS * >D0F4 * BR AMSOFF * PERMANENTLY * BR AMSON * ADD TO THE * BR SISRON * TABLE IF * BR SISROF * NEEDED. * ******************************************************* GLPARZ CEQ LPARZ,@CHAT BR ERRSYN RTN STRFCH XML PGMCHR XML PARSE BYTE >B6 RTN STRGET CALL STRFCH CEQ >65,@FAC2 BR ERRSNM * STRING NUM MISMATCH RTN NUMFCH CALL STRFCH CEQ >65,@FAC2 BS ERRSNM * STRING NUM MISMATCH RTN CFIFCH XML CFI CEQ >03,@FAC+10 BS ERRBV * NUMERIC OVERFLOW RTN GETNUM CALL SUBLP3 CEQ >B3,@CHAT BR ERRSYN RTN NGOOD XML PGMCHR CEQ >80,@CHAT BS ERRSYN * ? CALL SNDER CEQ >65,@FAC2 BR ERRBA * BAD ARGUMENT DST >001C,@FAC DST @SREF,@FAC4 DST @BYTES,@FAC6 BR SNDASS SNDER XML SYM XML SMB XML VPUSH RTN CIFSND XML CIF SNDASS XML ASSGNV RTN SUBLP3 CALL NUMFCH CALL CFIFCH RTN DSKSUB TEXT 'DSK#.' DEVNAM XML PGMCHR Advance program pointer XML PARSE Parse to ')' BYTE RPARZ 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 CEQ 1,@FAC7 BS DEV0 RTN *********************************************************** POKER DATA BEEP STRI 'POKER' CALL POKER(vdpr#,value) DATA $+2 CALL GLPARZ POKAGN CALL GETNUM DCHE 8,@FAC BS ERRBV ST @FAC1,@VAR0 CALL SUBLP3 CASE @VAR0 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 ****************************** BEEP DATA HONK STRI 'BEEP' CALL BEEP DATA $+2 CALL ACCTON BR LDRET2 HONK DATA DIRECT STRI 'HONK' CALL HONK DATA $+2 CALL BADTON BR LDRET2 ****************************** DIRECT DATA AMAP STRI 'DIR' CALL DIR(pathname) DATA GKCAT ****************************** AMAP DATA APASS STRI 'AMSMAP' CALL AMSMAP DATA $+2 CALL AMSMAP BR LDRET2 AMSMAP CALL AMSSUB DST >1D01,@STORE XML >F0 RTN APASS DATA ARWOFF STRI 'AMSPASS' CALL AMSPASS DATA $+2 CALL AMSPAS BR LDRET2 AMSPAS CALL AMSSUB DST >1E01,@STORE XML >F0 RTN ARWOFF DATA ARWON STRI 'AMSOFF' CALL AMSOFF DATA $+2 CALL AMSOFF BR LDRET2 AMSOFF CALL AMSSUB DST >1E00,@STORE XML >F0 RTN ARWON DATA ISRON STRI 'AMSON' CALL AMSON DATA $+2 CALL AMSON BR LDRET2 AMSON CALL AMSSUB DST >1D00,@STORE XML >F0 RTN AMSSUB MOVE 24,G@AMSCRU,@>8300 RTN ****************************************************** * CPU PROGRAM FOR >8300 SCATCH PAD SUBROUTINE AMSCPU * *********************************************************** * * AORG >8300 AMSCRU DATA >8302 * CPUPGM DATA >8302 * First address. DATA >0420 * BLWP @AMSCPU * Switch contex DATA >830C * DATA >04E0 * CLR @>837C * Clear for GPL DATA >837C * DATA >045B * RT * Return to GPL. ****************************************************** * * AMS CPU SUBPROGRAM DATA >834A * AMSCPU DATA >834A DATA >8310 * DATA AMSCRU DATA >020C * AMSCRU LI R12,>1E00 DATA >1E00 * DATA >1D00 * SBO 0 DATA >0380 * RTWP *********************************************************** * * END ****************************************************** ISRON DATA ISROFF STRI 'ISRON' CALL ISRON(variable) DATA $+2 CALL GLPARZ CALL SUBLP3 DCZ @FAC BS ERRBV CALL SISRON BR PEEK5 SISRON MOVE 14,G@GISRON,@>8300 XML >F0 RTN ****************************************************** * CPU PROGRAM FOR >8300 SCRATCH PAD CPU ISR HOOK ON * ****************************************************** * * AORG >8300 GISRON DATA >8302 * DATA >8302 DATA >C820 * MOV @>834A,@>83C4 DATA >834A * DATA >83C4 * DATA >04E0 * EXIT CLR @>837C DATA >837C * DATA >045B * RT * * END ****************************************************** ISROFF DATA ABANK STRI 'ISROFF' CALL ISROFF(variable) DATA $+2 CALL GLPARZ CALL SISROF XML PGMCHR DST @FAC,@VAR0 CALL SNDER CALL CLRFAC DST @VAR0,@FAC CALL CIFSND BR PEEK5 SISROF DST @>8318,@FAC4 MOVE 26,G@GISROF,@>8300 XML >F0 DST @FAC4,@>8318 RTN ****************************************************** * CPU PROGRAM FOR >8300 SCRATCH PAD CPU ISR HOOK OFF * ****************************************************** * AORG >8300 GISROF DATA >8302 * DATA >8302 DATA >C820 * ISROFF MOV @>83C4,@>83C4 DATA >83C4 * DATA >83C4 * DATA >1305 * JEQ NHOOK DATA >C820 * MOV @>83C4,@>834A DATA >83C4 * DATA >834A * DATA >04E0 * NHOOK CLR @>83C4 DATA >83C4 * DATA >04E0 * CLR @>837C DATA >837C * DATA >045B * RT * * END ****************************************************** ABANK DATA AINIT STRI 'AMSBANK' CALL AMSBANK(bank-number) DATA $+2 CALL GLPARZ * ( ? CALL GETNUM * Get low page. DCHE 240,@FAC * Too high? BS ERRBV * ERROR BAD VALUE. ADD 16,@FAC1 * Add 16 to it. XML VPUSH * Save low page. CALL SUBLP3 * Get high page. DCHE 240,@FAC * Too high? BS ERRBV * ERROR BAD VALUE. ADD 16,@FAC1 * Add 16 to it. ST @FAC1,@ARG1 * Save high page. CALL AMSMAP * AMSMAP CALL AMSON * AMSON XML VPOP * Fetch low page. ST @FAC1,@ARG * Save low page. ST @>4004,@FAC * Save old page. ST @>4006,@FAC1 * Save old page 2. ST @ARG,@>4004 * Load new low page. DST @>2000,@FAC6 * Save new low first bytes. ST @ARG,@>4006 * Duplicate new low page. DST >5555,@>2000 * Write test bytes. DCEQ >5555,@>3000 * Did it write? BR AMSERR * No, ERROR. DST @FAC6,@>2000 * Restore new low bytes. ST @ARG1,@>4004 * Load new high page. DST @>2000,@FAC6 * Save new high first bytes. ST @ARG1,@>4006 * Duplicate new high page. DST >9999,@>2000 * Write test bytes. DCEQ >9999,@>3000 * Did it write? BR AMSERR * No, ERROR. DST @FAC6,@>2000 * Restore new high bytes. ST @ARG,@>4004 * Load new low page. ST @ARG1,@>4006 * Load new high page. CALL AMSOFF * AMSOFF BR PEEK5 ******************************* AMSERR ST @FAC,@>4004 * Restore old page. ST @FAC1,@>4006 * Restore old page 2. CALL AMSOFF * AMSOFF XML SCROLL FMT SCRO >60 ROW 23 COL 2 HTEX '* WARNING AMS BANK ERROR *' FEND BR ERRBV ******************************* AINIT DATA CHRALL STRI 'AMSINIT' CALL AMSINIT DATA $+2 CALL AMSON DST >5FFE,@FAC ST >0F,@FAC2 AINITL MOVE 1,@FAC2,@0(@FAC) DDECT @FAC DEC @FAC2 BR AINITL CALL AMSOFF CALL AMSMAP BR LDRET2 ******************************* CHRALL DATA USER STRI 'CHARSETALL' CALL CHARSETALL DATA $+2 ST 95,@FAC2 All 95 charaters CALL CHRTBL Load RXB character set ST >10,V@>080F Set 1st set to Black on Tran MOVE 16,V@>080F,V@>0810 Ripple the rest BR LDRET2 Return to XB ******************************* UPAB BYTE 0,>14,>09,>00,80,0,0,0,0,0 USER DATA BASIC STRI 'USER' CALL USER(path-string) DATA $+2 CALL GLPARZ CALL STRGET ST >20,V@>08C0 MOVE 80,V@>08C0,V@>08C1 MOVE 10,G@UPAB,V@>08C0 ST @FAC7,V@>08C9 MOVE @FAC6,V*FAC4,V@>08CA BR PEEK5 ************************** BASIC DATA BSAVE STRI 'BASIC' CALL BASIC DATA $+2 CALL CLSALL GBASIC EQU >216F B GBASIC ************************** BSAVE DATA BLOAD STRI 'BSAVE' CALL BSAVE(pathstring) DATA $+2 CALL MYSAL * Get pathname ST >06,V@>1000 * LOAD opcode MOVE 8192,@>2000,V@>1020 CALL MYDOIT * DSRLNK opcode BR PEEK5 * Done BLOAD DATA RENAME STRI 'BLOAD' CALL BLOAD(pathstring) DATA $+2 CALL MYSAL * Get pathname ST >05,V@>1000 * LOAD opcode CALL MYDOIT * DSRLNK opcode MOVE 8192,V@>1020,@>2000 BR PEEK5 * Done MYDOIT DST >1009,@FAC12 * Get buffer address in VDP CALL LINK * DSRLNK BYTE >08 BS ERRFE * File Error CLOG >E0,V@>1001 * Set error bits BR ERRFE RTN MYSAL XML COMPCT * GARBAGE COLLECTION DST @STREND,@ARG2 * String end DSUB @VSPTR,@ARG2 * Value Stack PoinTeR DSUB 63,@ARG2 * Size of Value Stack DCHE >2021,@ARG2 * Size of buffer BR ERRSO * Error Stack Overflow CALL GLPARZ * ( CALL STRGET * Pathstring CLR V@>1000 * 0 BYTE MOVE >2020,V@>1000,V@>1001 * Ripple DST >1020,V@>1002 * Buffer address DST >2000,V@>1006 * Number of bytes ST @FAC7,V@>1009 * Length byte MOVE @FAC6,V*FAC4,V@>100A * Pathstring RTN ******************************* DSKDSR FETCH @FAC16 * Get Length of name FETCH @FAC17 * Get Subroutine # DST @FAC16,V@>03C0 * Load into PAB DST >03C0,@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 * ******************************* DSKNAM CALL DEVNAM * DSK# or SCS# or WDS# MOVE 5,V*FAC4,@ARG * Get device name ST @ARG3,@DEVNUM * Save device number characte DCEQ 'DS',@ARG BR DSKNA2 CEQ 'K',@ARG2 BR ERRBA * Error Bad Argument CLR @DFLAG * Set DSK flag BR DSKNA4 DSKNA2 DCEQ 'SC',@ARG BS DSKNA3 DCEQ 'WD',@ARG BR ERRBA * Error Bad Argument DSKNA3 CEQ 'S',@ARG2 BR ERRBA * Error Bad Argument ST >FF,@DFLAG * Set SCS or WDS flag DST @FAC4,@VAR5 * Get string address DDEC @VAR5 * Point to PATH string length DSKNA4 SUB 48,@DEVNUM * DSK# or SCS# or WDS# -1 RTN ******************************* GETFN CALL STRGET * Get string CH 10,@FAC7 * Length > 10? BS ERRNTL * Error Name Too Long DCZ @FAC6 * Length = 0? BS ERRBA * Error Bad Argument ST >20,V@>03C0 * Clear PATH buffer MOVE 31,V@>03C0,V@>03C1 MOVE @FAC6,V*FAC4,V@>03C2 * File name RTN ******************************* PATH ST @DEVNUM,@FAC2 * Device # DST @VAR5,@FAC4 * Pathname address lenght/st[ DST >0127,V@>03C0 * Opcode of PATHNAME subrouti CALL RWDSR * Read/Write DSR LINK RTN ******************************* RENAME DATA PROT STRI 'RENAME' CALL RENAME(pathname,oldname, DATA $+2 CALL GLPARZ * ( RENAGN CALL DSKNAM * Pathname CEQ COMMAZ,@CHAT * , BR ERRSYN CZ @DFLAG * DSK? BS RENNP * Yes CALL PATH * Set PATH RENNP CALL GETFN * Old name CEQ COMMAZ,@CHAT * , BR ERRSYN CALL STRGET * New name CH 10,@FAC7 * Length > 10? BS ERRNTL * Error Name Too Long MOVE @FAC6,V*FAC4,V@>03D0 ST @DEVNUM,@FAC2 * DSK# DST >03D0,@FAC4 * New name DST >03C2,@FAC6 * Old name CZ @DFLAG * DSK? BS RENDSK * Yes CALL DSKDSR * DSKLNK DATA >0123 * Opcode RENAME HARD B RENEND RENDSK CALL DSKDSR * DSKLNK DATA >0113 * Opcode RENAME DISK RENEND CEQ COMMAZ,@CHAT * , BS RENAGN * Redo again BR PEEK5 ******************************* PROT DATA SCSI STRI 'PROTECT' CALL PROTECT(pathname,filenam DATA $+2 CALL GLPARZ * ( PROAGN CALL DSKNAM * Get pathname CEQ COMMAZ,@CHAT * , BR ERRSYN CZ @DFLAG * DSK? BS PRONP * Yes CALL PATH * Set PATH PRONP CALL GETFN * Get filename CALL SUBLP3 * Option number CLR @FAC3 * UNPROTECT DCZ @FAC * Unprotect? BS UNPRO ST >FF,@FAC3 * PROTECT UNPRO ST @DEVNUM,@FAC2 * DSK# DST >03C2,@FAC4 * Filename CZ @DFLAG * DSK? BS PRODSK * Yes CALL DSKDSR * DSRLNK DATA >0122 * Opcode PROTECT HARD B PROEND PRODSK CALL DSKDSR * DSRLNK DATA >0112 * Opcode PROTECT DISK PROEND CEQ COMMAZ,@CHAT * , BS PROAGN * Redo again BR PEEK5 ******************************* SCSI DATA MKDIR STRI 'SCSI' CALL SCSI(pathname,string-var DATA $+2 CALL GLPARZ * ( SCSAGN CALL DSKNAM * Pathname CEQ COMMAZ,@CHAT * , BR ERRSYN DST 44,@BYTES * Length of buffer XML GETSTR * Get string space ST @DEVNUM,@FAC2 * SCS# DST @SREF,@FAC4 * String address CALL DSKDSR * DSRLNK DATA >011C * Opcode EXAMINE SCSI CALL NGOOD * Assign string to variable CEQ COMMAZ,@CHAT * , BS SCSAGN * Redo again BR PEEK5 ******************************* MKDIR DATA RMDIR STRI 'MKDIR' CALL MKDIR(pathname,directory DATA $+2 DST 255,@BYTES * For sector 0 access XML GETSTR * Get string space DST @SREF,@VAR0 * Buffer address DDEC @VAR0 * Make it 256 byte buffer CALL GLPARZ * ( MKDIR2 CALL DSKNAM * Pathname CEQ COMMAZ,@CHAT * , BR ERRSYN CZ @DFLAG * DSK? BR MKDIR3 * No, Hard CH 5,@FAC7 * Length > 5? BS ERRNTL * Error Name Too Long CALL GETFN * Filename ST >FF,@FAC3 * Set to READ SECTOR BR VOL1ST VOL2ND CLR @FAC3 * Set to WRITE SECTOR VOL1ST DCLR @FAC * Returned SECTOR ST @DEVNUM,@FAC2 * DSK# DST @VAR0,@FAC4 * Buffer Address DCLR @FAC6 * Sector number 0 DSK CALL DSKDSR * DSRLNK DATA >0110 * Opcode SECTOR DISK MOVE 10,V@>03C2,V*VAR0 * Copy VOLUME name over old n CZ @FAC3 * First pass? BR VOL2ND * No, again B MKDIR4 MKDIR3 CALL PATH * Set PATH CALL GETFN * Directory name ST @DEVNUM,@FAC2 * SCS# DST >03C2,@FAC4 * Name address CALL DSKDSR * DSRLNK DATA >0128 * Opcode MAKE DIRECTORY HARD MKDIR4 CEQ COMMAZ,@CHAT * , BS MKDIR2 * Redo again BR PEEK5 ******************************* RMDIR DATA CUTDIR STRI 'RMDIR' CALL RMDIR(pathname,directory DATA $+2 CALL GLPARZ * ( RMDIR2 CALL DSKNAM * Pathname CEQ COMMAZ,@CHAT * , BR ERRSYN CALL PATH * Set PATH CALL GETFN * Directory name ST @DEVNUM,@FAC2 * SCS# DST >03C2,@FAC4 * Name address CALL DSKDSR * DSRLNK DATA >0129 * Opcode REMOVE DIRECTORY HAR CEQ COMMAZ,@CHAT * , BS RMDIR2 * Redo again BR PEEK5 ******************************* CUTDIR DATA FCOPY STRI 'CUTDIR' CALL CUTDIR(pathname,director DATA $+2 CALL GLPARZ * ( CUTDI2 CALL DSKNAM * Pathname CEQ COMMAZ,@CHAT * , BR ERRSYN CALL GETFN * Set PATH ST @DEVNUM,@FAC2 * SCS# DST >03C2,@FAC4 * Name address CALL DSKDSR * DSRLNK DATA >012A * Opcode CUT DIRECTORY HARD CEQ COMMAZ,@CHAT * , BS CUTDI2 * Redo again BR PEEK5 ******************************* FCOPY DATA SECTOR STRI 'FCOPY' CALL FCOPY(pathname,filename, DATA $+2 XML COMPCT * GARBAGE COLLECT DST @STREND,@ARG2 * String end DSUB @VSPTR,@ARG2 * Value Stack PoinTeR address DSUB 63,@ARG2 * Value stack size DCHE >1001,@ARG2 * Buffer size BR ERRSO * Error Stack Overflow CALL GLPARZ * ( FCOPY1 CLR @VAR0 * Clear Additional info Buffe MOVE 12,@VAR0,@VARV * Ripple CALL DSKNAM * 1st pathname CEQ COMMAZ,@CHAT * , BR ERRSYN DST @DFLAG,V@BUFSRT * FLAG/DSK# DST @VAR5,@STRPTR * 1st pathname CALL GETFN * 1st filename CEQ COMMAZ,@CHAT * , BR ERRSYN CALL DSKNAM * 2nd pathname CEQ COMMAZ,@CHAT * , BR ERRSYN DST @DFLAG,V@BUFEND * FLAG/DSK# DST @VAR5,@CURLIN * 2nd pathname CALL STRGET * 2nd filename CH 10,@FAC7 * Length > 10 ? BS ERRNTL * Error Name Too Long CZ @FAC7 * Length = 0? BS ERRBA * Error Bad Argument MOVE @FAC6,V*FAC4,V@>03D0 * 2nd filename into buffer CLR @FAC3 * ADDitional INFO ACCESS CODE CALL FREAD * READ FILE HEADER DST @MNUM,@SREF * Save number of Sectors of F CLR @FAC3 * ADDITIONAL INFO ACCESS CODE CALL FWRTE * WRITE FILE HEADER DST @SREF,@ARG * Get Total number of Sectors DCLR @FAC * Clear PASS counter FCOPY2 DCHE 4,@ARG * ARG>=4 Sectors? BS FCOPY3 * Yes INC @FAC * PASS+1 ST @ARG1,@FAC1 * Save number of sectors left B FCOPY4 * Done FCOPY3 DSUB 3,@ARG * Sectors-3 INC @FAC * PASS+1 B FCOPY2 * Loop FCOPY4 DST @FAC,@SREF * PASS/Number of sectors left DCLR @CURINC * Sector Pointer FCOPY5 CEQ 1,@SREF * Last PASS? BR FCOPY6 * No ST @SREF+1,@FAC3 * Number of sectors Left to r B FCOPY7 * Continue FCOPY6 ST 3,@FAC3 * 3 Sectors to read FCOPY7 DST @CURINC,V@>03BA * Save SECTOR NUMBER TO USE DST @CURINC,@MNUM * SECTOR NUMBER TO USE CALL FREAD * READ FILE SECTOR CEQ 1,@SREF * Last PASS? BR FCOPY8 * No ST @SREF+1,@FAC3 * Number of sectors left to w B FCOPY9 * Continue FCOPY8 ST 3,@FAC3 * 3 Sectors to write FCOPY9 DST V@>03BA,@CURINC * Get sectors to write DST @CURINC,@MNUM * SECTOR NUMBER TO USE CALL FWRTE * WRITE FILE SECTOR DADD 3,@CURINC * SECTOR+3 DEC @SREF * PASS-1 BR FCOPY5 * 0=END CEQ COMMAZ,@CHAT * , BS FCOPY1 * Redo again BR PEEK5 ******************************* FREAD DST V@BUFSRT,@DFLAG * 1st FLAG/DSR# CZ @DFLAG * DSK? BS FREAD1 * Yes DST @STRPTR,@VAR5 * 1st path CALL PATH * Set PATH FREAD1 DST >1000,@VAR0 * Buffer address in Add info ST @DEVNUM,@FAC2 * DSK# DST >03C2,@FAC4 * 1st filename CLR @FAC6 * Pointer to Additional info CZ @DFLAG * DSK? BS FREAD2 * Yes DST >0124,V@>03C0 * Opcode INPUT HARD B FREAD3 FREAD2 DST >0114,V@>03C0 * Opcode INPUT DISK FREAD3 CALL RWDSR * DSRLNK RTN ******************************* FWRTE DST V@BUFEND,@DFLAG * 2nd FLAG/DSK# CZ @DFLAG * DSK? BS FWRTE1 * Yes DST @CURLIN,@VAR5 * 2nd PATH CALL PATH * Set PATH FWRTE1 DST >1000,@VAR0 * Buffer Address in Add info ST @DEVNUM,@FAC2 * DSK# DST >03D0,@FAC4 * 2nd Filename CLR @FAC6 * Pointer to Add info block CZ @DFLAG * DSK# BS FWRTE2 * Yes DST >0125,V@>03C0 * Opcode OUTPUT HARD B FWRTE3 FWRTE2 DST >0115,V@>03C0 * Opcode OUTPUT DISK FWRTE3 CALL RWDSR * DSKLNK RTN ******************************* RWDSR DST >03C0,@FAC12 * Buffer address CALL LINK * DSRLNK BYTE >0A * Subroutine CZ @FAC6 * ERRORS? BR ERRFE * Yes, File Error RTN ******************************* SECTOR DATA >0000 STRI 'SECTOR' CALL SECTOR(pathname,RWflag,# DATA $+2 XML COMPCT DST @STREND,@ARG2 DSUB @VSPTR,@ARG2 DSUB 63,@ARG2 DCHE 260,@ARG2 BR ERRSO CALL GLPARZ * ( SECTOS CALL DSKNAM * Pathname CEQ COMMAZ,@CHAT * , BR ERRSYN CALL GETNUM * R/W Flag CLR @VAR0 * WRITE Flag DCZ @FAC * 0000? BS SECTO1 INC @VAR0 * READ Flag SECTO1 CALL GETNUM * #SECTORS DCZ @FAC * 0000? BS ERRBV DCHE 33,@FAC * Only 32 sectors allowed. BS ERRBV ST @FAC1,@VARV * Save # SECTORS CALL STRGET * SECTOR $ DCZ @FAC6 * 0 string length? BS ERRBV CZ @DFLAG * DSK? BR SECTO2 * No. DCHE 5,@FAC6 * String to long? BS ERRBV SECTO2 DCHE 9,@FAC6 * String to long HARD? BS ERRBV DST @FAC6,@BYTES * Save string length value. DADD @FAC6,@FAC4 * Point past end of string. DDEC @FAC4 * Offset to end of string. CLR @FAC6 * Sector # buffer. MOVE 4,@FAC6,@FAC7 * Clear buffer. DST >03C3,@ARG * # number pointer CLR V@>03C0 MOVE 4,V@>03C0,V@>03C1 SECTO3 CLR @FAC SECTO4 ST V*FAC4,@FAC * Get character. CHE 71,@FAC * G or higher? BS ERRBA CHE 65,@FAC * A or higher? BS SECTO5 CHE 58,@FAC * : or higher? BS ERRBA CHE 48,@FAC * 0 or higher? BR ERRBA SECTO5 SUB 48,@FAC * - 0 CHE 10,@FAC * 10 or higher? BR SECTO6 SUB >07,@FAC * - 7 SECTO6 ST @FAC,@FAC2 * Save nibble. DDEC @FAC4 * $ pointer - 1 DDEC @BYTES * $ length - 1 BR SECTO7 ST @FAC2,V*ARG * Save # B SECTOA * End routine. SECTO7 ST V*FAC4,@FAC * Get character. CHE 71,@FAC * G or higher? BS ERRBA CHE 65,@FAC * A or higher? BS SECTO8 CHE 58,@FAC * : or higher? BS ERRBA CHE 48,@FAC * 0 or higher? BR ERRBA SECTO8 SUB 48,@FAC * - 0 CHE 10,@FAC * 10 or higher? BR SECTO9 SUB >07,@FAC * - 7 SECTO9 SLL 4,@FAC * Swap nibbles. ADD @FAC2,@FAC * Add old nibble. ST @FAC,V*ARG * Save # DDEC @ARG * # pointer - 1 DDEC @FAC4 * $ pointer - 1 DDEC @BYTES * $ length - 1 BR SECTO3 SECTOA MOVE 4,V@>03C0,@FAC6 * Get # CZ @DFLAG * DSK? BR SECTOB * No. DST @FAC8,@FAC6 * DISK SECTOB DCLR @SREF * CPU BUFFER SECTOC DCLR @FAC * Clear Returned Sector. ST @DEVNUM,@FAC2 * UNIT# ST @VAR0,@FAC3 * R/W Flag. DST >1000,@FAC4 * VDP BUFFER CZ @DFLAG * DSK? BS SECTOD * Yes. DST >0120,V@>03C0 * HARD B SECTOE SECTOD DST >0110,V@>03C0 * DISK SECTOE CZ @VAR0 * WRITE FLAG? BR SECRD * NO MOVE 256,@>2000(@SREF),V@>1000 * WRITE CPU BUFFER SECRD CALL RWDSR * DSR Access. CZ @VAR0 * WRITE FLAG? BS SECWRT * YES MOVE 256,V@>1000,@>2000(@SREF) * READ VDP BUFFER SECWRT DADD 256,@SREF * CPU BUFFER + 256 CZ @DFLAG * DSK? BS SECTOH * Yes. DCEQ >FFFF,@FAC8 * Overflow one word? BS SECTOG * Yes. DINC @FAC8 * SECTOR# - 1 HARD B SECTOI * No. SECTOG DCLR @FAC8 * HARD SECTOH DINC @FAC6 * SECTOR# + 1 DISK & HARD SECTOI DEC @VARV * #SECTORS - 1 BR SECTOC CEQ COMMAZ,@CHAT * ,? BS SECTOS * Repeat. BR PEEK5 *********************************************************** END Quote Link to comment Share on other sites More sharing options...
RXB Posted October 1, 2020 Share Posted October 1, 2020 Rich Editor Assembly from 2001 but all the original Editor Assembler GPL code is there also. Spoiler 99/4 GPL-ASSEMBLER (Pass 3) correct PAGE 0001 Version 2.0 (Weiand 1985) Options : LCSFPF [0001] [0002] *********************************************************** [0003] COPY 'DSK5.MYXB7-A' <0001> TITL 'REA GROM 7' <0002> * <0003> * GROM <0004> * <0005> 0000 G0000 EQU >0000 <0006> 0001 G0001 EQU >0001 <0007> 0010 DSRLNK EQU >0010 <0008> 0012 DSRRET EQU >0012 <0009> 001C BERR EQU >001C <0010> 0038 BGETSS EQU >0038 <0011> 6372 RXB EQU >6372 <0012> * <0013> * CPU <0014> * <0015> 8318 CHRCUR EQU >8318 <0016> 831C PABPTR EQU >831C <0017> 831E COUNT EQU >831E CATALOG COUNT FILES <0018> 8320 CURADD EQU >8320 <0019> 8322 CODE EQU >8322 <0020> 8324 STLN EQU >8324 <0021> 8326 ENDLN EQU >8326 <0022> 8342 XTOKEN EQU >8342 <0023> 8347 LDFLAG EQU >8347 <0024> 8348 FLAG EQU >8348 <0025> 8349 FLAG2 EQU >8349 <0026> 834A FAC EQU >834A <0027> 834B FAC1 EQU >834B <0028> 834C FAC2 EQU >834C <0029> 834D FAC3 EQU >834D <0030> 834E FAC4 EQU >834E <0031> 834F FAC5 EQU >834F <0032> 8350 FAC6 EQU >8350 <0033> 8351 FAC7 EQU >8351 <0034> 8352 FAC8 EQU >8352 <0035> 8353 FAC9 EQU >8353 <0036> 8354 ERCODE EQU >8354 <0037> 8355 FAC11 EQU >8355 <0038> 8356 FAC12 EQU >8356 <0039> 8356 VPAB EQU >8356 <0040> 835C ARG EQU >835C <0041> 836E VSTACK EQU >836E <0042> 8373 SUBSTK EQU >8373 <0043> 8374 KBNO EQU >8374 <0044> 8375 KEY EQU >8375 <0045> 8379 ITIMER EQU >8379 <0046> 837D VCHAR EQU >837D <0047> * <0048> * GENERAL <0049> * <0050> 0001 AID EQU 1 <0051> 0002 CLEAR EQU 2 <0052> 0006 REDO EQU 6 <0053> 000C PROCD EQU 12 <0054> 000D ENTER EQU 13 <0055> 000E BEGIN EQU 14 <0056> 000F BACK EQU 15 <0057> 0020 SPACE EQU 32 <0058> * XML's ************ <0059> 0002 ROUND EQU >02 <0060> 0023 CIF EQU >23 <0061> * VDP ************** <0062> 077F COLOR EQU >077F 99/4 GPL-ASSEMBLER (Pass 3) correct PAGE 0002 REA GROM 7 <0063> *********************************************************** <0064> GROM >E000 <0065> AORG >0000 <0066> TITL 'E/A GROM' <0067> * GROM Header <0068> E000 AA,10,01 BYTE >AA,>10,>01,>00 E003 00 <0069> * RXB PATCH CODE FOR RXB MODULE * <0070> E004 00,00 DATA >0000 * POWER UP <0071> E006 E0,10 DATA MENU * Cartridge menu <0072> E008 FC,B7 DATA VEIW40 * DSRs <0073> E00A 00,00 DATA >0000 * SUBROUTINES <0074> E00C 00,00,00 DATA >0000,>0000 E00F 00 <0075> E010 00,00 MENU BYTE >00,>00 <0076> E012 E0,25 DATA SOLDEA <0077> E014 10,52,58 STRI 'RXB SUPER E/A ' E017 42,20,53 E01A 55,50,45 E01D 52,20,45 E020 2F,41,20 E023 20,20 <0078> E025 06,E6,DB SOLDEA CALL NESCRN <0079> E028 CA,42,38 OLDEA CHE >38,@XTOKEN <0080> E02B 60,32 BS CLREA <0081> E02D CA,42,31 CHE >31,@XTOKEN <0082> E030 60,37 BS NEWEA <0083> E032 06,EF,65 CLREA CALL CLRREA <0084> E035 86,42 CLR @XTOKEN <0085> E037 87,8F,9D NEWEA DCLR @>2000 E03A 00 <0086> E03B 06,E6,E1 GE029 CALL EASCRN <0087> E03E 86,44 CLR @>8344 * SEARCH FLAG <0088> E040 BF,4A,0B DST >0B00,@FAC E043 00 <0089> E044 06,00,4A CALL UPCASE <0090> E047 86,74 GE056 CLR @KBNO <0091> E049 BF,4A,09 DST >0900,@FAC E04C 00 <0092> E04D 06,00,18 CALL LOCASE <0093> E050 86,A8,00 CLR V@>0800 <0094> E053 35,00,FF MOVE >00FF,V@>0800,V@>0801 E056 A8,01,A8 E059 00 <0095> E05A 39,00,06 MOVE 6,G@VREGS,#1 E05D 01,ED,DC <0096> E060 06,EE,22 CALL BUGS <0097> E063 31,00,10 MOVE 16,G@CURPAT,V@>08F0 E066 A8,F0,ED E069 CC <0098> E06A 31,00,10 MOVE 16,G@DARROW,V@>0C10 E06D AC,10,E1 E070 7F <0099> * <0100> * Display Main Menu <0101> * <0102> E071 BE,73,7E MMENU ST >7E,@SUBSTK <0103> E074 87,22 DCLR @CODE <0104> E076 87,48 DCLR @FLAG <0105> E078 86,47 CLR @LDFLAG <0106> E07A 07,20 ALL SPACE <0107> E07C CA,42,38 GE116 CHE >38,@XTOKEN <0108> E07F 60,86 BS MSCRN <0109> E081 CA,42,31 CHE >31,@XTOKEN 99/4 GPL-ASSEMBLER (Pass 3) correct PAGE 0003 E/A GROM <0110> E084 61,8F BS MYEAXB <0111> E086 87,7E MSCRN HOME <0112> E088 08 FMT <0113> E089 FF,08 COL 8 <0114> E08B 0F,46,49 HTEX 'FIRMWARE CONTROL' E08E 52,4D,57 E091 41,52,45 E094 20,43,4F E097 4E,54,52 E09A 4F,4C <0115> E09C A0 ROW+ 1 <0116> E09D FF,00 COL 0 <0117> E09F 5F,5F HCHAR 32,95 <0118> E0A1 A0 ROW+ 1 <0119> E0A2 FF,02 COL 2 <0120> E0A4 1C,52,58 HTEX 'RXB Editor & Assembler V=2001' E0A7 42,20,45 E0AA 64,69,74 E0AD 6F,72,20 E0B0 26,20,41 E0B3 73,73,65 E0B6 6D,62,6C E0B9 65,72,20 E0BC 56,3D,32 E0BF 30,30,31 <0121> E0C2 A0 ROW+ 1 <0122> E0C3 FF,00 COL 0 <0123> E0C5 5F,5F HCHA 32,95 <0124> E0C7 A0 ROW+ 1 <0125> E0C8 FF,08 COL 8 <0126> E0CA 11,30,20 HTEX '0 SCREEN COLORS' E0CD 20,20,20 E0D0 53,43,52 E0D3 45,45,4E E0D6 20,43,4F E0D9 4C,4F,52 E0DC 53 <0127> E0DD A1 ROW+ 2 <0128> E0DE FF,08 COL 8 <0129> E0E0 0A,31,20 HTEX '1 EDITOR' E0E3 20,20,20 E0E6 45,44,49 E0E9 54,4F,52 <0130> E0EC A1 ROW+ 2 <0131> E0ED FF,08 COL 8 <0132> E0EF 0D,32,20 HTEX '2 ASSEMBLER' E0F2 20,20,20 E0F5 41,53,53 E0F8 45,4D,42 E0FB 4C,45,52 <0133> E0FE A1 ROW+ 2 <0134> E0FF FF,08 COL 8 <0135> E101 10,33,20 HTEX '3 LOAD and RUN' E104 20,20,20 E107 4C,4F,41 E10A 44,20,61 E10D 6E,64,20 E110 52,55,4E <0136> E113 A1 ROW+ 2 <0137> E114 FF,08 COL 8 <0138> E116 07,34,20 HTEX '4 RUN' E119 20,20,20 E11C 52,55,4E <0139> E11F A1 ROW+ 2 99/4 GPL-ASSEMBLER (Pass 3) correct PAGE 0004 E/A GROM <0140> E120 FF,08 COL 8 <0141> E122 14,35,20 HTEX '5 RUN PROGRAM FILE' E125 20,20,20 E128 52,55,4E E12B 20,50,52 E12E 4F,47,52 E131 41,4D,20 E134 46,49,4C E137 45 <0142> E138 A1 ROW+ 2 <0143> E139 FF,08 COL 8 <0144> E13B 11,36,20 HTEX '6 R X B LOADER' E13E 20,20,20 E141 52,20,58 E144 20,42,20 E147 20,4C,4F E14A 41,44,45 E14D 52 <0145> E14E A1 ROW+ 2 <0146> E14F FF,08 COL 8 <0147> E151 0D,37,20 HTEX '7 DIRECTORY' E154 20,20,20 E157 44,49,52 E15A 45,43,54 E15D 4F,52,59 <0148> E160 A1 ROW+ 2 <0149> E161 FF,08 COL 8 <0150> E163 09,2E,20 HTEX '. R X B' E166 20,20,20 E169 52,20,58 E16C 20,42 <0151> E16E FB FEND <0152> E16F 03 NEWSCN SCAN <0153> E170 41,6F BR NEWSCN <0154> E172 D6,75,2E CEQ >2E,@KEY <0155> E175 61,7C BS RTRXB <0156> E177 D6,75,0F CEQ BACK,@KEY <0157> E17A 41,99 BR GE11F <0158> E17C 05,63,72 RTRXB B RXB <0159> E17F 00,10,18 DARROW DATA >0010,>18FC,>1810,>0000 * RIGHT ARROW E182 FC,18,10 E185 00,00 <0160> E187 00,20,60 DATA >0020,>60FC,>6020,>0000 * LEFT ARROW E18A FC,60,20 E18D 00,00 <0161> E18F 87,AF,22 MYEAXB DCLR V@>2250 E192 50 <0162> E193 BC,75,42 ST @XTOKEN,@KEY <0163> E196 BE,42,EA ST >EA,@XTOKEN <0164> E199 A6,75,30 GE11F SUB >30,@KEY <0165> E19C CA,75,0A CHE >0A,@KEY <0166> E19F 61,6F BS NEWSCN <0167> E1A1 8A,75 CASE @KEY <0168> E1A3 41,B7 BR COLORS * SCREEN COLOR 0 <0169> E1A5 42,46 BR EDITOR 1 <0170> E1A7 48,2D BR ASSEM 2 <0171> E1A9 49,E4 BR LANDR * EA3 3 <0172> E1AB 4A,59 BR RUN 4 <0173> E1AD 47,16 BR PRGRM * EA5 5 <0174> E1AF 4E,D9 BR XBINP * XBINPT 6 <0175> E1B1 56,C4 BR DIRECT * DIRECTORY 7 <0176> E1B3 40,28 BR OLDEA 8 <0177> E1B5 40,28 BR OLDEA 9 <0178> ******************************* 99/4 GPL-ASSEMBLER (Pass 3) correct PAGE 0005 E/A GROM <0179> * <0180> E1B7 07,20 COLORS ALL SPACE <0181> E1B9 06,E6,E1 CALL EASCRN <0182> E1BC 08 FMT <0183> E1BD FF,0B COL >0B <0184> E1BF FE,01 ROW 1 <0185> E1C1 09,2A,20 HTEX '* COLORS *' E1C4 43,4F,4C E1C7 4F,52,53 E1CA 20,2A <0186> E1CC FF,03 COL 3 <0187> E1CE A2 ROW+ 3 <0188> E1CF 0D,46,4F HTEX 'FORGROUND = F' E1D2 52,47,52 E1D5 4F,55,4E E1D8 44,20,20 E1DB 3D,20,46 <0189> E1DE FF,03 COL 3 <0190> E1E0 A2 ROW+ 3 <0191> E1E1 0D,42,41 HTEX 'BACKGROUND = B' E1E4 43,4B,47 E1E7 52,4F,55 E1EA 4E,44,20 E1ED 3D,20,42 <0192> E1F0 FF,03 COL 3 <0193> E1F2 A4 ROW+ 5 <0194> E1F3 1A,41,4E HTEX 'ANY OTHER KEY FOR MAIN MENU' E1F6 59,20,4F E1F9 54,48,45 E1FC 52,20,4B E1FF 45,59,20 E202 46,4F,52 E205 20,4D,41 E208 49,4E,20 E20B 4D,45,4E E20E 55 <0195> E20F FB FEND <0196> E210 03 COLSCN SCAN <0197> E211 42,10 BR COLSCN <0198> E213 BC,00,A7 ST V@COLOR,@>8300 * Get COLOR byte E216 7F <0199> E217 E6,00,04 SRL 4,@>8300 * Foreground <0200> E21A BC,01,A7 ST V@COLOR,@>8301 * Get COLOR byte E21D 7F <0201> E21E E2,01,04 SLL 4,@>8301 * Strip left bits <0202> E221 E6,01,04 SRL 4,@>8301 * Restore bits <0203> E224 D6,75,46 CEQ 'F',@KEY <0204> E227 42,2D BR COLBAC <0205> E229 90,00 INC @>8300 * Foreground+1 <0206> E22B 42,3A BR COLEND <0207> E22D D6,75,42 COLBAC CEQ 'B',@KEY <0208> E230 40,3B BR GE029 <0209> E232 90,01 INC @>8301 * Background+1 <0210> E234 E2,01,04 SLL 4,@>8301 * Strip left bits <0211> E237 E6,01,04 SRL 4,@>8301 * Restore bits <0212> E23A E2,00,04 COLEND SLL 4,@>8300 * Restore left bits <0213> E23D A0,00,01 ADD @>8301,@>8300 * Get Background <0214> E240 BC,A7,7F ST @>8300,V@COLOR * Add to COLOR E243 00 <0215> E244 41,B7 BR COLORS <0216> * <0217> * Main Menu Option 1: EDIT <0218> * <0219> E246 06,E6,E1 EDITOR CALL EASCRN 99/4 GPL-ASSEMBLER (Pass 3) correct PAGE 0006 E/A GROM <0220> E249 87,48 DCLR @FLAG <0221> E24B 86,47 CLR @LDFLAG <0222> E24D 08 FMT <0223> E24E FF,0B COL >0B <0224> E250 FE,01 ROW 1 <0225> E252 09,2A,20 HTEX '* EDITOR *' E255 45,44,49 E258 54,4F,52 E25B 20,2A <0226> E25D A2 ROW+ 3 <0227> E25E FF,03 COL 3 <0228> E260 08,31,20 HTEX '1 LOAD' E263 20,20,20 E266 4C,4F,41 E269 44 <0229> E26A A0 ROW+ 1 <0230> E26B 96 COL+ 23 <0231> E26C 08,32,20 HTEX '2 EDIT' E26F 20,20,20 E272 45,44,49 E275 54 <0232> E276 A0 ROW+ 1 <0233> E277 96 COL+ 23 <0234> E278 08,33,20 HTEX '3 SAVE' E27B 20,20,20 E27E 53,41,56 E281 45 <0235> E282 A0 ROW+ 1 <0236> E283 96 COL+ 23 <0237> E284 09,34,20 HTEX '4 PRINT' E287 20,20,20 E28A 50,52,49 E28D 4E,54 <0238> E28F A0 ROW+ 1 <0239> E290 95 COL+ 22 <0240> E291 09,35,20 HTEX '5 VIEW ' E294 20,20,20 E297 56,49,45 E29A 57,20 <0241> E29C A0 ROW+ 1 <0242> E29D 95 COL+ 22 <0243> E29E 09,36,20 HTEX '6 PURGE' E2A1 20,20,20 E2A4 50,55,52 E2A7 47,45 <0244> E2A9 A0 ROW+ 1 <0245> E2AA 95 COL+ 22 <0246> E2AB FB FEND <0247> E2AC 87,48 DCLR @FLAG <0248> E2AE BE,73,7E ST >7E,@SUBSTK <0249> E2B1 BF,20,00 DST >0082,@CURADD E2B4 82 <0250> E2B5 03 GE19B SCAN <0251> E2B6 42,B5 BR GE19B <0252> E2B8 D6,75,0F CEQ BACK,@KEY <0253> E2BB 60,32 BS CLREA <0254> E2BD A6,75,31 SUB >31,@KEY <0255> E2C0 CA,75,06 CHE >06,@KEY <0256> E2C3 62,B5 BS GE19B <0257> E2C5 BC,00,75 ST @KEY,@>8300 <0258> E2C8 AA,00,40 MUL >40,@>8300 <0259> E2CB A1,20,00 DADD @>8300,@CURADD <0260> E2CE BE,B0,20 ST 130,V*CURADD E2D1 82 99/4 GPL-ASSEMBLER (Pass 3) correct PAGE 0007 E/A GROM <0261> E2D2 BC,04,75 ST @KEY,@>8304 <0262> E2D5 D6,75,05 CEQ >05,@KEY * PURGE? <0263> E2D8 42,FF BR GE1E4 * No, next check <0264> * Edit Menu Option 6: PURGE <0265> E2DA 08 FMT <0266> E2DB A1 ROW+ 2 <0267> E2DC 13,41,72 HTEX 'Are you sure (Y/N)? ' E2DF 65,20,79 E2E2 6F,75,20 E2E5 73,75,72 E2E8 65,20,28 E2EB 59,2F,4E E2EE 29,3F,20 <0268> E2F1 FB FEND <0269> E2F2 06,E9,B7 CALL YESNO <0270> E2F5 D6,75,59 CEQ >59,@KEY <0271> E2F8 42,46 BR EDITOR <0272> E2FA 06,E7,08 CALL CLRXOP <0273> E2FD 42,46 GE1E2 BR EDITOR <0274> E2FF D6,75,03 GE1E4 CEQ >03,@KEY * PRINT? <0275> E302 63,54 BS GE1FC * YES! <0276> E304 D6,75,04 CEQ >04,@KEY * VIEW <0277> E307 63,54 BS GE1FC <0278> E309 D7,8F,9D DCEQ >55AA,@>2000 * EDIT1 loaded? E30C 00,55,AA <0279> E30F 63,54 BS GE1FC * Yes <0280> E311 35,00,63 MOVE 99,V@>2250,@>EA00 E314 8F,67,00 E317 AF,22,50 <0281> E31A BC,8F,7C ST @XTOKEN,@>FFFB E31D FB,42 <0282> E31F 86,42 CLR @XTOKEN <0283> E321 31,00,08 MOVE 8,G@CUREDP,V@>08F0 E324 A8,F0,ED E327 C4 <0284> E328 06,E7,AE CALL LODPGM * Load EDIT1 <0285> E32B E8,28 DATA DEDIT1 <0286> E32D 06,EE,3C CALL DEVICE <0287> E330 D6,75,0F CEQ BACK,@KEY <0288> E333 62,46 BS EDITOR <0289> E335 BE,47,01 ST 1,@LDFLAG * Set Editor flag <0290> E338 06,E7,D9 GE1F6 CALL PGMLOD <0291> E33B D7,8F,9D DCEQ >55AA,@>2000 E33E 00,55,AA <0292> E341 42,46 BR EDITOR <0293> E343 06,E7,08 CALL CLRXOP <0294> E346 35,00,63 MOVE 99,@>EA00,V@>2250 E349 AF,22,50 E34C 8F,67,00 <0295> E34F BC,42,8F ST @>FFFB,@XTOKEN E352 7C,FB <0296> E354 D6,04,01 GE1FC CEQ >01,@>8304 * Edit? <0297> E357 63,CF BS EMOPT2 * Yes <0298> E359 D6,04,02 CEQ >02,@>8304 * Save? <0299> E35C 43,90 BR GE237 * No <0300> * Edit Menu Option 3: SAVE <0301> E35E 86,42 CLR @XTOKEN <0302> E360 08 FMT <0303> E361 FF,02 COL 2 <0304> E363 FE,10 ROW 16 <0305> E365 12,44,56 HTEX 'DV80 Format (Y/N)? ' E368 38,30,20 E36B 46,6F,72 E36E 6D,61,74 99/4 GPL-ASSEMBLER (Pass 3) correct PAGE 0008 E/A GROM E371 20,28,59 E374 2F,4E,29 E377 3F,20 <0306> E379 FB FEND <0307> E37A 06,E9,B7 CALL YESNO <0308> E37D D6,75,59 CEQ >59,@KEY <0309> E380 43,85 BR GE22C <0310> E382 B6,49,02 OR >02,@FLAG2 <0311> E385 D6,75,0F GE22C CEQ BACK,@KEY <0312> E388 62,46 BS EDITOR <0313> E38A BF,20,02 DST >0262,@CURADD E38D 62 <0314> E38E 43,9B BR GE23B <0315> E390 BF,20,02 GE237 DST >0202,@CURADD * Print or View or Load E393 02 <0316> E394 35,00,FF MOVE 255,V@>0200,V@>201 E397 A2,01,A2 E39A 00 <0317> E39B 31,00,0A GE23B MOVE 10,G@GE25B,V*CURADD E39E B0,20,E3 E3A1 C5 <0318> E3A2 A3,20,00 DADD >0040,@CURADD E3A5 40 <0319> E3A6 BF,1C,10 DST >1000,@PABPTR E3A9 00 <0320> E3AA 06,E5,1D CALL GETALL <0321> E3AD D6,75,0F CEQ BACK,@KEY * BACK? <0322> E3B0 60,32 BS CLREA <0323> E3B2 D6,04,02 CEQ >02,@>8304 * Save? <0324> E3B5 64,31 BS GE2B5 <0325> E3B7 D6,04,03 CEQ >03,@>8304 * Print? <0326> E3BA 64,55 BS GE2D9 <0327> E3BC D6,04,04 CEQ >04,@>8304 * View? <0328> E3BF 64,06 BS VIT40 <0329> E3C1 8E,04 CZ @>8304 * Load? <0330> E3C3 63,DC BS GE272 <0331> E3C5 46,49,4C GE25B TEXT 'FILE NAME?' E3C8 45,20,4E E3CB 41,4D,45 E3CE 3F <0332> * Edit Menu Option 2: EDIT <0333> E3CF 0F,23 EMOPT2 XML >23 <0334> E3D1 6B,3C BS GE8B0 <0335> E3D3 39,00,01 MOVE 1,G@GE271,#1 E3D6 01,E3,DB <0336> E3D9 42,46 BR EDITOR <0337> E3DB E0 GE271 BYTE >E0 <0338> E3DC 06,E3,E5 GE272 CALL GE27B <0339> E3DF 0F,21 XML >21 <0340> E3E1 6B,3F BS GE8B3 <0341> E3E3 42,46 BR EDITOR <0342> E3E5 BE,E0,01 GE27B ST >04,V@>0001(@PABPTR) E3E8 1C,04 <0343> E3EA B2,49,FD AND >FD,@FLAG2 <0344> E3ED BD,56,1C GE283 DST @PABPTR,@VPAB <0345> E3F0 A3,56,00 DADD >0009,@VPAB E3F3 09 <0346> E3F4 06,00,10 CALL DSRLNK <0347> E3F7 08 BYTE >08 <0348> E3F8 6B,E4 BS CHKERR <0349> E3FA DA,E0,01 CLOG >E0,V@>0001(@PABPTR) E3FD 1C,E0 <0350> E3FF 44,18 BR GE29C <0351> E401 BE,B0,1C ST >02,V*PABPTR 99/4 GPL-ASSEMBLER (Pass 3) correct PAGE 0009 E/A GROM E404 02 <0352> E405 00 RTN <0353> E406 BE,42,EA VIT40 ST >EA,@XTOKEN <0354> E409 31,00,05 MOVE 5,G@VIEWR,V@>2256 E40C AF,22,56 E40F E4,13 <0355> E411 44,55 BR GE2D9 <0356> E413 03,56,34 VIEWR STRI 'V40' E416 30 <0357> E417 0D BYTE >0D <0358> E418 BC,00,E0 GE29C ST V@>0001(@PABPTR),@>8300 E41B 01,1C <0359> E41D B2,00,1F AND >1F,@>8300 <0360> E420 D6,00,04 CEQ >04,@>8300 <0361> E423 44,2F BR GE2B3 <0362> E425 BE,E0,01 ST >14,V@>0001(@PABPTR) E428 1C,14 <0363> E42A B6,49,02 OR >02,@FLAG2 <0364> E42D 43,ED BR GE283 <0365> E42F 4B,E4 GE2B3 BR CHKERR <0366> E431 BE,E0,01 GE2B5 ST >02,V@>0001(@PABPTR) E434 1C,02 <0367> E436 DA,49,02 CLOG >02,@FLAG2 <0368> E439 64,40 BS GE2C4 <0369> E43B BE,E0,01 ST >12,V@>0001(@PABPTR) E43E 1C,12 <0370> E440 06,E5,6A GE2C4 CALL DOIO <0371> E443 BE,B0,1C ST >03,V*PABPTR E446 03 <0372> E447 BE,E0,05 ST >50,V@>0005(@PABPTR) E44A 1C,50 <0373> E44C 0F,22 XML >22 <0374> E44E 6B,3F BS GE8B3 <0375> E450 06,E5,66 CALL CLOSE <0376> E453 42,46 BR EDITOR <0377> * Edit Menu Option 4 or 5: PRINT or VIEW output <0378> E455 06,E3,E5 GE2D9 CALL GE27B <0379> E458 08 FMT <0380> E459 FF,02 COL 2 <0381> E45B FE,14 ROW 20 <0382> E45D 0B,44,45 HTEX 'DEVICE NAME?' E460 56,49,43 E463 45,20,4E E466 41,4D,45 E469 3F <0383> E46A FB FEND <0384> E46B BF,20,02 DST >02C2,@CURADD * Cursor Address E46E C2 <0385> E46F BF,1C,11 DST >1100,@PABPTR * PAB address E472 00 <0386> E473 D6,04,04 CEQ >04,@>8304 * VIEW? <0387> E476 64,7D BS VFILE * No <0388> E478 86,42 CLR @XTOKEN <0389> E47A 06,EF,65 CALL CLRREA <0390> E47D 06,E5,1D VFILE CALL GETALL <0391> E480 86,42 CLR @XTOKEN <0392> E482 BE,E0,05 ST >50,V@>0005(@PABPTR) E485 1C,50 <0393> E487 BE,E0,01 GE30A ST >12,V@>0001(@PABPTR) E48A 1C,12 <0394> E48C BF,E0,02 DST >1080,V@>0002(@PABPTR) E48F 1C,10,80 <0395> E492 06,E5,6A CALL DOIO <0396> E495 D6,E0,04 CEQ >20,V@>0004(@PABPTR) 99/4 GPL-ASSEMBLER (Pass 3) correct PAGE 0010 E/A GROM E498 1C,20 <0397> E49A 44,9F BR GE322 <0398> E49C B6,48,02 OR >02,@FLAG <0399> E49F BE,B0,1C GE322 ST >03,V*PABPTR E4A2 03 <0400> E4A3 DA,48,02 CLOG >02,@FLAG <0401> E4A6 65,0A BS GE38D <0402> E4A8 BF,1C,10 GE32B DST >1000,@PABPTR E4AB 00 <0403> E4AC 06,E5,51 CALL BLNKBU <0404> E4AF 06,E5,6A CALL DOIO <0405> E4B2 BF,1C,11 DST >1100,@PABPTR E4B5 00 <0406> E4B6 BF,00,10 DST >1080,@>8300 E4B9 80 <0407> E4BA A3,00,00 DADD >004F,@>8300 E4BD 4F <0408> E4BE BE,02,50 ST >50,@>8302 <0409> E4C1 BC,03,B0 GE344 ST V*>8300,@>8303 E4C4 00 <0410> E4C5 D6,03,20 CEQ >20,@>8303 <0411> E4C8 64,DE BS GE361 <0412> E4CA D6,03,0C CEQ >0C,@>8303 <0413> E4CD 44,DC BR GE35F <0414> E4CF BE,B0,00 ST >20,V*>8300 E4D2 20 <0415> E4D3 06,E5,6A CALL DOIO <0416> E4D6 06,E5,6A CALL DOIO <0417> E4D9 06,E5,6A CALL DOIO <0418> E4DC 44,E4 GE35F BR GE367 <0419> E4DE 93,00 GE361 DDEC @>8300 <0420> E4E0 92,02 DEC @>8302 <0421> E4E2 44,C1 BR GE344 <0422> E4E4 06,E5,6A GE367 CALL DOIO <0423> E4E7 A6,02,20 SUB >20,@>8302 <0424> E4EA CE,02,00 CGT >00,@>8302 <0425> E4ED 44,FD BR GE380 <0426> E4EF A3,E0,02 DADD >0020,V@>0002(@PABPTR) E4F2 1C,00,20 <0427> E4F5 BC,E0,05 ST @>8302,V@>0005(@PABPTR) E4F8 1C,02 <0428> E4FA 05,E4,E4 B GE367 <0429> E4FD BF,E0,02 GE380 DST >1080,V@>0002(@PABPTR) E500 1C,10,80 <0430> E503 BE,E0,05 ST >20,V@>0005(@PABPTR) E506 1C,20 <0431> E508 44,A8 BR GE32B <0432> E50A BF,1C,10 GE38D DST >1000,@PABPTR E50D 00 <0433> E50E 06,E5,51 CALL BLNKBU <0434> E511 06,E5,6A CALL DOIO <0435> E514 BF,1C,11 DST >1100,@PABPTR E517 00 <0436> E518 06,E5,6A CALL DOIO <0437> E51B 45,0A BR GE38D <0438> E51D 06,E5,51 GETALL CALL BLNKBU <0439> * Build PAB with name <0440> E520 06,E5,7F BLDPAB CALL VZERO <0441> E523 BD,E0,02 DST @PABPTR,V@>0002(@PABPTR) E526 1C,1C <0442> E528 A3,E0,02 DADD >0080,V@>0002(@PABPTR) E52B 1C,00,80 <0443> E52E BE,E0,08 ST >00,V@>0008(@PABPTR) E531 1C,00 99/4 GPL-ASSEMBLER (Pass 3) correct PAGE 0011 E/A GROM <0444> E533 BF,E0,04 DST >5000,V@>0004(@PABPTR) E536 1C,50,00 <0445> E539 87,AF,22 DCLR V@>2250 E53C 50 <0446> E53D 06,E5,8B CALL GETINP <0447> E540 8F,50 DCZ @FAC6 <0448> E542 65,50 BS GE3CF <0449> E544 34,50,E0 PABNAM MOVE @FAC6,V*FAC4,V@>000A(@PABPTR) E547 0A,1C,B0 E54A 4E <0450> E54B BC,E0,09 ST @FAC7,V@>0009(@PABPTR) E54E 1C,51 <0451> E550 00 GE3CF RTN <0452> E551 A3,1C,00 BLNKBU DADD >0080,@PABPTR E554 80 <0453> E555 BE,B0,1C ST >20,V*PABPTR E558 20 <0454> E559 35,00,4F MOVE >004F,V*PABPTR,V@>0001(@PABPTR) E55C E0,01,1C E55F B0,1C <0455> E561 A7,1C,00 DSUB >0080,@PABPTR E564 80 <0456> E565 00 RTN <0457> E566 BE,B0,1C CLOSE ST >01,V*PABPTR E569 01 <0458> E56A BD,56,1C DOIO DST @PABPTR,@VPAB <0459> E56D A3,56,00 DADD >0009,@VPAB E570 09 <0460> E571 06,00,10 CALL DSRLNK <0461> E574 08 BYTE >08 <0462> E575 6B,E4 BS CHKERR <0463> E577 DA,E0,01 CLOG >E0,V@>0001(@PABPTR) E57A 1C,E0 <0464> E57C 4B,E4 BR CHKERR <0465> E57E 00 RTN <0466> E57F 86,B0,1C VZERO CLR V*PABPTR <0467> E582 35,00,45 MOVE >0045,V*PABPTR,V@>0001(@PABPTR) E585 E0,01,1C E588 B0,1C <0468> E58A 00 RTN <0469> E58B 06,E5,BE GETINP CALL GETKEY <0470> E58E BD,20,24 DST @STLN,@CURADD <0471> E591 BE,00,3C ST >3C,@>8300 <0472> E594 87,50 DCLR @FAC6 <0473> E596 D6,B0,20 GE415 CEQ SPACE,V*CURADD E599 20 <0474> E59A 45,AC BR GE42B <0475> E59C 91,20 DINC @CURADD <0476> E59E 92,00 DEC @>8300 <0477> E5A0 45,96 BR GE415 <0478> E5A2 BD,20,24 DST @STLN,@CURADD <0479> E5A5 DA,48,04 CLOG >04,@FLAG <0480> E5A8 45,BD BR GE43C <0481> E5AA 45,8B BR GETINP <0482> E5AC BD,4E,20 GE42B DST @CURADD,@FAC4 <0483> E5AF D6,B0,20 GE42E CEQ SPACE,V*CURADD E5B2 20 <0484> E5B3 65,BD BS GE43C <0485> E5B5 91,50 DINC @FAC6 <0486> E5B7 91,20 DINC @CURADD <0487> E5B9 92,00 DEC @>8300 <0488> E5BB 45,AF BR GE42E <0489> E5BD 00 GE43C RTN <0490> * Key input routine 99/4 GPL-ASSEMBLER (Pass 3) correct PAGE 0012 E/A GROM <0491> E5BE BE,18,1F GETKEY ST >1F,@CHRCUR <0492> E5C1 BD,26,20 DST @CURADD,@ENDLN <0493> E5C4 BD,24,20 DST @CURADD,@STLN <0494> E5C7 86,79 GE446 CLR @ITIMER <0495> E5C9 C0,18,B0 EX V*CURADD,@CHRCUR E5CC 20 [0004] *********************************************************** [0005] COPY 'DSK5.MYXB7-B' <0001> * REPEAT KEYS <0002> E5CD 03 GE44C SCAN <0003> E5CE 65,F6 BS GE456 <0004> E5D0 CA,79,07 CHE 7,@ITIMER <0005> E5D3 45,CD BR GE44C <0006> E5D5 D6,42,EA CEQ >EA,@XTOKEN * ANYTHING <0007> E5D8 45,C7 BR GE446 <0008> E5DA BD,76,AF PSCANX DST V@>2250,@>8376 E5DD 22,50 <0009> E5DF BC,75,EF ST V@>2257(@>8376),@KEY E5E2 22,57,76 <0010> E5E5 91,76 DINC @>8376 <0011> E5E7 BD,AF,22 DST @>8376,V@>2250 E5EA 50,76 <0012> E5EC D4,AF,22 CEQ @>8376,V@>2256 E5EF 56,76 <0013> E5F1 45,F6 BR GE456 <0014> E5F3 BE,75,0D ST >0D,@KEY * Store ENTER <0015> E5F6 D6,B0,20 GE456 CEQ >1F,V*CURADD E5F9 1F <0016> E5FA 46,00 BR GE460 <0017> E5FC C0,18,B0 EX V*CURADD,@CHRCUR E5FF 20 <0018> E600 BD,00,20 GE460 DST @CURADD,@>8300 <0019> E603 A5,00,24 DSUB @STLN,@>8300 <0020> E606 C6,75,19 CH >19,@KEY * SPACE key and higher? <0021> E609 66,21 BS GE46B <0022> E60B D6,75,07 CEQ 7,@KEY * FCTN 3? <0023> E60E 46,3B BR GE485 <0024> E610 BE,B0,24 ST SPACE,V*STLN E613 20 <0025> E614 35,00,3F MOVE >003F,V*STLN,V@1(@STLN) E617 E0,01,24 E61A B0,24 <0026> E61C BD,20,24 DST @STLN,@CURADD <0027> E61F 45,BE BR GETKEY <0028> E621 DA,48,01 GE46B CLOG >01,@FLAG <0029> E624 46,93 BR GE4DD <0030> E626 BC,B0,20 GE470 ST @KEY,V*CURADD E629 75 <0031> E62A C5,20,26 DCH @ENDLN,@CURADD <0032> E62D 46,32 BR GE47C <0033> E62F BD,26,20 DST @CURADD,@ENDLN <0034> E632 C6,01,3F GE47C CH >3F,@>8301 <0035> E635 65,C7 BS GE446 <0036> E637 91,20 DINC @CURADD <0037> E639 45,C7 BR GE446 <0038> E63B B2,48,FE GE485 AND >FE,@FLAG <0039> E63E D6,75,0F CEQ BACK,@KEY <0040> E641 46,4F BR GE499 <0041> E643 DA,48,20 CLOG >20,@FLAG <0042> E646 40,32 BR CLREA * GE97F <0043> E648 DA,48,04 CLOG >04,@FLAG <0044> E64B 40,32 BR CLREA <0045> E64D 42,46 BR EDITOR <0046> E64F D6,75,09 GE499 CEQ >09,@KEY 99/4 GPL-ASSEMBLER (Pass 3) correct PAGE 0013 E/A GROM <0047> E652 66,32 BS GE47C <0048> E654 D6,75,08 CEQ >08,@KEY <0049> E657 46,61 BR GE4AB <0050> E659 8E,01 CZ @>8301 <0051> E65B 65,C7 BS GE446 <0052> E65D 93,20 DDEC @CURADD <0053> E65F 45,C7 BR GE446 <0054> E661 D6,75,0D GE4AB CEQ >0D,@KEY <0055> E664 66,B9 BS GE503 <0056> E666 D6,75,03 CEQ >03,@KEY <0057> E669 46,89 BR GE4D3 <0058> E66B BE,B0,20 ST SPACE,V*CURADD E66E 20 <0059> E66F BD,00,26 DST @ENDLN,@>8300 <0060> E672 A5,00,20 DSUB @CURADD,@>8300 <0061> E675 CE,01,00 CGT >00,@>8301 <0062> E678 45,C7 BR GE446 <0063> E67A 34,00,B0 MOVE @>8300,V@>0001(@CURADD),V*CURADD E67D 20,E0,01 E680 20 <0064> E681 BE,B0,26 ST SPACE,V*ENDLN E684 20 <0065> E685 93,26 DDEC @ENDLN <0066> E687 45,C7 BR GE446 <0067> E689 D6,75,04 GE4D3 CEQ >04,@KEY <0068> E68C 46,B7 BR GE501 <0069> E68E B6,48,01 OR >01,@FLAG <0070> E691 45,C7 BR GE446 <0071> E693 BD,00,26 GE4DD DST @ENDLN,@>8300 <0072> E696 A5,00,24 DSUB @STLN,@>8300 <0073> E699 C6,01,3F CH >3F,@>8301 <0074> E69C 65,C7 BS GE446 <0075> E69E BD,00,26 DST @ENDLN,@>8300 <0076> E6A1 A5,00,20 DSUB @CURADD,@>8300 <0077> E6A4 91,00 DINC @>8300 <0078> E6A6 34,00,A3 MOVE @>8300,V*CURADD,V@>03C0 E6A9 C0,B0,20 <0079> E6AC 34,00,E0 MOVE @>8300,V@>03C0,V@>0001(@CURADD) E6AF 01,20,A3 E6B2 C0 <0080> E6B3 91,26 DINC @ENDLN <0081> E6B5 46,26 BR GE470 <0082> E6B7 45,C7 GE501 BR GE446 <0083> E6B9 00 GE503 RTN <0084> * Check for Expansion Memory <0085> E6BA BC,00,8F EXPMEM ST @>2000,@>8300 E6BD 9D,00 <0086> E6BF BE,8F,9D ST >FF,@>2000 E6C2 00,FF <0087> E6C4 D6,8F,9D CEQ >FF,@>2000 E6C7 00,FF <0088> E6C9 4B,A4 BR GE91D <0089> E6CB 86,8F,9D CLR @>2000 E6CE 00 <0090> E6CF 8E,8F,9D CZ @>2000 E6D2 00 <0091> E6D3 4B,A4 BR GE91D <0092> E6D5 BC,8F,9D ST @>8300,@>2000 E6D8 00,00 <0093> E6DA 00 RTN <0094> E6DB 04,F4 NESCRN BACK >F4 <0095> E6DD BE,A7,7F ST >F4,V@COLOR E6E0 F4 <0096> E6E1 BE,A3,00 EASCRN ST >D0,V@>0300 99/4 GPL-ASSEMBLER (Pass 3) correct PAGE 0014 E/A GROM E6E4 D0 <0097> E6E5 BC,A3,80 ST V@COLOR,V@>0380 E6E8 A7,7F <0098> E6EA 35,00,1F MOVE 31,V@>0380,V@>0381 E6ED A3,81,A3 E6F0 80 <0099> E6F1 07,20 ALL SPACE <0100> E6F3 3D,00,01 MOVE 1,V@COLOR,#7 E6F6 07,A7,7F <0101> E6F9 00 RTN <0102> E6FA BE,A3,80 USSCRN ST >13,V@>0380 E6FD 13 <0103> E6FE 35,00,1F MOVE 31,V@>0380,V@>0381 E701 A3,81,A3 E704 80 <0104> E705 07,20 ALL SPACE <0105> E707 00 RTN <0106> E708 86,8F,7C CLRXOP CLR @>FFD8 E70B D8 <0107> E70C 35,00,05 MOVE 5,@>FFD8,@>FFD9 E70F 8F,7C,D9 E712 8F,7C,D8 <0108> E715 00 RTN <0109> * <0110> * Main Menu Option 5: RUN PROGRAM FILE <0111> * <0112> E716 07,20 PRGRM ALL SPACE <0113> E718 08 FMT <0114> E719 FF,06 COL 6 <0115> E71B FE,01 ROW 1 <0116> E71D 13,2A,20 HTEX '* RUN PROGRAM FILE *' E720 52,55,4E E723 20,50,52 E726 4F,47,52 E729 41,4D,20 E72C 46,49,4C E72F 45,20,2A <0117> E732 FB FEND <0118> E733 D6,42,FF CEQ >FF,@XTOKEN <0119> E736 47,44 BR NOEABF <0120> E738 35,00,40 MOVE 64,V@>2400,V@>2255 E73B AF,22,55 E73E AF,24,00 <0121> E741 BE,42,EA ST >EA,@XTOKEN <0122> E744 06,ED,E2 NOEABF CALL BINIT2 * INITILIZE LOW8K <0123> E747 B6,49,08 OR >08,@FLAG2 <0124> E74A BF,20,01 DST >0102,@CURADD E74D 02 <0125> E74E 31,00,0A MOVE 10,G@GE25B,V*CURADD * FILE NAME? E751 B0,20,E3 E754 C5 <0126> E755 A3,20,00 DADD >0040,@CURADD E758 40 <0127> E759 B6,48,04 OR >04,@FLAG <0128> E75C 06,E5,8B CALL GETINP <0129> E75F D6,51,01 CEQ 1,@FAC7 <0130> E762 47,85 BR NO1KEY <0131> E764 BF,AF,24 DST >000B,V@>2400 E767 00,00,0B <0132> E76A 31,00,05 MOVE 5,G@DDSK1,V@>2402 E76D AF,24,02 E770 E8,23 <0133> E772 BC,AF,24 ST V*STLN,V@>2405 E775 05,B0,24 99/4 GPL-ASSEMBLER (Pass 3) correct PAGE 0015 E/A GROM <0134> E778 31,00,06 MOVE 6,G@DUTIL1,V@>2407 E77B AF,24,07 E77E EE,17 <0135> E780 BE,42,FF ST >FF,@XTOKEN <0136> E783 47,16 BR PRGRM <0137> E785 8F,50 NO1KEY DCZ @FAC6 * ENTER? <0138> E787 47,93 BR GE597 * No <0139> E789 BE,44,31 ST '1',@>8344 * Search flag <0140> E78C 06,E7,AE MYSRCH CALL LODPGM * Load DATA <0141> E78F EE,17 DATA DUTIL1 * DSK1.UTIL1 <0142> E791 47,A2 BR GE5A6 <0143> E793 06,E7,BB GE597 CALL LODUSR <0144> E796 06,E5,44 CALL PABNAM <0145> E799 D7,B0,4E DCEQ >4353,V*FAC4 * CS ?? E79C 43,53 <0146> E79E 47,A2 BR GE5A6 * ????? <0147> E7A0 07,20 ALL SPACE <0148> E7A2 06,E7,D9 GE5A6 CALL PGMLOD <0149> E7A5 06,E6,FA CALL USSCRN <0150> E7A8 0F,F0 XML >F0 <0151> E7AA 6B,6F BS GE8E3 <0152> E7AC 4B,34 BR GE8A8 <0153> E7AE 88,10 LODPGM FETCH @>8310 <0154> E7B0 88,11 FETCH @>8311 <0155> E7B2 33,00,05 MOVE 5,G@G0000(@>8310),V@>100F E7B5 AF,10,0F E7B8 00,00,10 <0156> E7BB 87,00 LODUSR DCLR @>8300 <0157> E7BD BF,1C,10 DST >1000,@PABPTR E7C0 00 <0158> E7C1 31,00,0F MOVE 15,G@PAB,V*PABPTR E7C4 B0,1C,E8 E7C7 19 <0159> E7C8 8E,44 CZ @>8344 * Check Search flag <0160> E7CA 67,D1 BS PMSG * No, go on <0161> E7CC BC,E0,0D ST @>8344,V@13(@PABPTR) * Yes, store next drive # E7CF 1C,44 <0162> E7D1 31,00,0F PMSG MOVE 15,G@PLEASE,V@>02A2 E7D4 A2,A2,E9 E7D7 A8 <0163> E7D8 00 RTN <0164> * Load Program <0165> E7D9 06,E5,6A PGMLOD CALL DOIO <0166> E7DC 35,00,06 MOVE 6,V@>1380,@>8310 E7DF 10,AF,13 E7E2 80 <0167> E7E3 8F,00 DCZ @>8300 <0168> E7E5 47,EA BR GE5E5 <0169> E7E7 BD,00,14 DST @>8314,@>8300 <0170> E7EA A7,14,83 GE5E5 DSUB >8300,@>8314 E7ED 00 <0171> E7EE 34,12,C0 MOVE @>8312,V@>1386,@>8300(@>8314) E7F1 00,14,AF E7F4 13,86 <0172> E7F6 8F,10 DCZ @>8310 <0173> E7F8 68,0A BS GE605 <0174> E7FA 87,02 DCLR @>8302 <0175> E7FC BC,03,AF ST V@>1009,@>8303 E7FF 10,09 <0176> E801 A3,02,10 DADD >1009,@>8302 E804 09 <0177> E805 90,B0,02 INC V*>8302 <0178> E808 47,D9 BR PGMLOD <0179> E80A BE,A2,A2 GE605 ST SPACE,V@>02A2 99/4 GPL-ASSEMBLER (Pass 3) correct PAGE 0016 E/A GROM E80D 20 <0180> E80E 35,00,13 MOVE 19,V@>02A2,V@>02A3 E811 A2,A3,A2 E814 A2 <0181> E815 06,E5,7F CALL VZERO <0182> E818 00 RTN <0183> E819 05,00,13 PAB BYTE >05,>00,>13,>80,>00,>00,>21,>00 E81C 80,00,00 E81F 21,00 <0184> E821 00,0A DLEN BYTE >00,>0A <0185> E823 44,53,4B DDSK1 TEXT 'DSK1.' E826 31,2E <0186> E828 45,44,49 DEDIT1 TEXT 'EDIT1' E82B 54,31 <0187> *********************************************************** <0188> * <0189> * Main Menu Option 2: ASSEMBLER <0190> * <0191> E82D 07,20 ASSEM ALL SPACE <0192> E82F 08 FMT <0193> E830 FF,0A COL 10 <0194> E832 FE,01 ROW 1 <0195> E834 0C,2A,20 HTEX '* ASSEMBLER *' E837 41,53,53 E83A 45,4D,42 E83D 4C,45,52 E840 20,2A <0196> E842 FB FEND <0197> E843 87,48 DCLR @FLAG <0198> E845 86,47 CLR @LDFLAG <0199> E847 BE,73,7E ST >7E,@SUBSTK <0200> E84A B6,48,20 OR >20,@FLAG <0201> E84D D7,8F,9D DCEQ >AA55,@>2000 E850 00,AA,55 <0202> E853 68,80 BS GE687 <0203> E855 35,00,63 MOVE 99,V@>2250,@>EA00 E858 8F,67,00 E85B AF,22,50 <0204> E85E BC,8F,7C ST @XTOKEN,@>FFFB E861 FB,42 <0205> E863 86,42 CLR @XTOKEN <0206> E865 06,E7,AE CALL LODPGM <0207> E868 EE,12 DATA DASSM1 <0208> E86A 06,EE,3C CALL DEVICE <0209> E86D D6,75,0F CEQ BACK,@KEY <0210> E870 60,32 BS CLREA <0211> E872 BE,47,02 ST 2,@LDFLAG <0212> E875 06,E7,D9 GE654 CALL PGMLOD <0213> E878 D7,8F,9D DCEQ >AA55,@>2000 E87B 00,AA,55 <0214> E87E 48,2D BR ASSEM <0215> * CALL FILES (4) <0216> E880 BF,AF,13 GE687 DST >0116,V@>1380 E883 80,01,16 <0217> E886 BF,56,13 DST >1380,@VPAB E889 80 <0218> E88A BE,4C,04 ST >04,@FAC2 <0219> E88D 06,00,10 CALL DSRLNK <0220> E890 0A BYTE >0A <0221> E891 35,00,63 MOVE 99,@>EA00,V@>2250 E894 AF,22,50 E897 8F,67,00 <0222> E89A BC,42,8F ST @>FFFB,@XTOKEN E89D 7C,FB 99/4 GPL-ASSEMBLER (Pass 3) correct PAGE 0017 E/A GROM <0223> E89F 07,20 ALL 32 <0224> E8A1 08 FMT <0225> E8A2 FF,0A COL 10 <0226> E8A4 FE,01 ROW 1 <0227> E8A6 0C,2A,20 HTEX '* ASSEMBLER *' E8A9 41,53,53 E8AC 45,4D,42 E8AF 4C,45,52 E8B2 20,2A <0228> E8B4 FF,02 COL 2 <0229> E8B6 FE,04 ROW 4 <0230> E8B8 10,53,6F HTEX 'Source File Name?' E8BB 75,72,63 E8BE 65,20,46 E8C1 69,6C,65 E8C4 20,4E,61 E8C7 6D,65,3F <0231> E8CA FB FEND <0232> E8CB BF,1C,10 DST >1000,@PABPTR E8CE 00 <0233> E8CF BF,20,00 DST >00C2,@CURADD E8D2 C2 <0234> E8D3 06,E5,20 CALL BLDPAB <0235> E8D6 D6,75,0F CEQ BACK,@KEY * BACK? <0236> E8D9 60,32 BS CLREA <0237> E8DB BF,E0,02 DST >1080,V@>0002(@PABPTR) E8DE 1C,10,80 <0238> E8E1 06,E3,E5 CALL GE27B <0239> E8E4 86,42 CLR @XTOKEN <0240> E8E6 08 FMT <0241> E8E7 FF,02 COL 2 <0242> E8E9 FE,08 ROW 8 <0243> E8EB 10,4F,62 HTEX 'Object File Name?' E8EE 6A,65,63 E8F1 74,20,46 E8F4 69,6C,65 E8F7 20,4E,61 E8FA 6D,65,3F <0244> E8FD FB FEND <0245> E8FE BF,1C,11 DST >1100,@PABPTR E901 00 <0246> E902 BF,20,01 DST >0142,@CURADD E905 42 <0247> E906 06,E5,20 CALL BLDPAB <0248> E909 BE,E0,01 ST >00,V@>0001(@PABPTR) E90C 1C,00 <0249> E90E BF,E0,02 DST >1180,V@>0002(@PABPTR) E911 1C,11,80 <0250> E914 06,E5,6A CALL DOIO <0251> E917 B6,48,40 OR >40,@FLAG <0252> E91A 08 FMT <0253> E91B FF,02 COL 2 <0254> E91D FE,0C ROW 12 <0255> E91F 0E,4C,69 HTEX 'List File Name?' E922 73,74,20 E925 46,69,6C E928 65,20,4E E92B 61,6D,65 E92E 3F <0256> E92F FB FEND <0257> E930 BF,1C,12 DST >1200,@PABPTR E933 00 <0258> E934 B6,48,04 OR >04,@FLAG <0259> E937 BF,20,01 DST >01C2,@CURADD 99/4 GPL-ASSEMBLER (Pass 3) correct PAGE 0018 E/A GROM E93A C2 <0260> E93B 06,E5,20 CALL BLDPAB <0261> E93E 8F,50 DCZ @FAC6 <0262> E940 69,53 BS GE736 <0263> E942 BE,E0,01 ST >12,V@>0001(@PABPTR) E945 1C,12 <0264> E947 BF,E0,02 DST >1280,V@>0002(@PABPTR) E94A 1C,12,80 <0265> E94D 06,E5,6A CALL DOIO <0266> E950 B6,48,80 OR >80,@FLAG <0267> E953 08 GE736 FMT <0268> E954 FF,02 COL 2 <0269> E956 FE,10 ROW 16 <0270> E958 07,4F,70 HTEX 'Options?' E95B 74,69,6F E95E 6E,73,3F <0271> E961 FB FEND <0272> E962 BF,20,02 DST >0242,@CURADD E965 42 <0273> E966 06,E5,8B CALL GETINP <0274> E969 B2,48,FB AND >FB,@FLAG <0275> E96C 8F,50 DCZ @FAC6 <0276> E96E 49,73 BR GE756 <0277> E970 BD,4E,20 DST @CURADD,@FAC4 <0278> E973 35,00,0F GE756 MOVE 15,V*FAC4,@>20D2 E976 8F,9D,D2 E979 B0,4E <0279> E97B 06,E7,08 CALL CLRXOP <0280> E97E 07,20 ALL SPACE <0281> E980 0F,21 XML >21 <0282> E982 6B,3F BS GE8B3 <0283> E984 06,E7,08 GE767 CALL CLRXOP <0284> E987 BF,1C,10 DST >1000,@PABPTR E98A 00 <0285> E98B 06,E5,66 CALL CLOSE <0286> E98E BF,1C,11 DST >1100,@PABPTR E991 00 <0287> E992 06,E5,66 CALL CLOSE <0288> E995 DA,48,80 CLOG >80,@FLAG <0289> E998 69,A1 BS GE784 <0290> E99A BF,1C,12 DST >1200,@PABPTR E99D 00 <0291> E99E 06,E5,66 CALL CLOSE <0292> E9A1 86,48 GE784 CLR @FLAG <0293> E9A3 06,EC,C4 CALL WENTER <0294> E9A6 40,28 BR OLDEA <0295> E9A8 50,6C,65 PLEASE TEXT 'Please wait ...' E9AB 61,73,65 E9AE 20,77,61 E9B1 69,74,20 E9B4 2E,2E,2E <0296> * Get Yes/No reply <0297> E9B7 BE,18,1F YESNO ST >1F,@CHRCUR <0298> E9BA 86,79 GE7A2 CLR @ITIMER <0299> E9BC C0,18,7D EX @VCHAR,@CHRCUR <0300> E9BF BE,74,03 GE7A7 ST >03,@KBNO <0301> E9C2 03 SCAN <0302> E9C3 69,CC BS GE7B1 <0303> E9C5 CA,79,06 CHE >06,@ITIMER <0304> E9C8 49,BF BR GE7A7 <0305> E9CA 49,BA BR GE7A2 <0306> E9CC D6,75,0F GE7B1 CEQ BACK,@KEY <0307> E9CF 69,DB BS GE7C0 <0308> E9D1 D6,75,59 CEQ >59,@KEY 99/4 GPL-ASSEMBLER (Pass 3) correct PAGE 0019 E/A GROM <0309> E9D4 69,DB BS GE7C0 <0310> E9D6 D6,75,4E CEQ >4E,@KEY <0311> E9D9 49,BA BR GE7A2 <0312> E9DB BC,7D,75 GE7C0 ST @KEY,@VCHAR <0313> E9DE BE,74,05 ST >05,@KBNO <0314> E9E1 86,42 CLR @XTOKEN <0315> E9E3 00 RTN <0316> * <0317> * Main Menu Option 3: LOAD AND RUN <0318> * <0319> E9E4 87,48 LANDR DCLR @FLAG <0320> E9E6 B6,49,01 OR >01,@FLAG2 <0321> E9E9 07,20 ALL SPACE <0322> E9EB 08 FMT <0323> E9EC FF,08 COL 8 <0324> E9EE FE,00 ROW 0 <0325> E9F0 0F,2A,20 HTEX '* LOAD and RUN *' E9F3 4C,4F,41 E9F6 44,20,61 E9F9 6E,64,20 E9FC 52,55,4E E9FF 20,2A <0326> EA01 89 COL+ 10 <0327> EA02 A1 ROW+ 2 <0328> EA03 09,46,49 HTEX 'FILE NAME?' EA06 4C,45,20 EA09 4E,41,4D EA0C 45,3F <0329> EA0E FB FEND <0330> EA0F 06,E6,BA CALL EXPMEM <0331> EA12 B6,49,40 OR >40,@FLAG2 <0332> EA15 BE,A0,A2 GE7F2 ST SPACE,V@162 EA18 20 <0333> EA19 35,00,3B MOVE >003B,V@162,V@163 EA1C A0,A3,A0 EA1F A2 <0334> EA20 BF,20,00 DST 162,@CURADD EA23 A2 <0335> EA24 B6,48,04 OR >04,@FLAG <0336> EA27 BF,1C,10 DST >1000,@PABPTR EA2A 00 <0337> EA2B 06,E5,1D CALL GETALL <0338> EA2E 86,42 CLR @XTOKEN <0339> EA30 8F,50 DCZ @FAC6 <0340> EA32 4A,3B BR GE816 <0341> EA34 06,ED,E2 CALL BINIT2 <0342> EA37 4A,59 BR RUN <0343> EA39 4A,46 BR GE821 <0344> EA3B DA,49,40 GE816 CLOG >40,@FLAG2 <0345> EA3E 6A,46 BS GE821 <0346> EA40 06,ED,EA CALL BINIT3 <0347> EA43 B2,49,BF AND >BF,@FLAG2 <0348> EA46 BE,E0,01 GE821 ST >04,V@>0001(@PABPTR) EA49 1C,04 <0349> EA4B BD,56,1C GE826 DST @PABPTR,@VPAB <0350> EA4E A3,56,00 DADD >0009,@VPAB EA51 09 <0351> EA52 0F,22 XML >22 <0352> EA54 6B,3F BS GE8B3 <0353> EA56 05,EA,15 B GE7F2 <0354> * <0355> * Main Menu Option 4: RUN <0356> * <0357> EA59 07,20 RUN ALL SPACE 99/4 GPL-ASSEMBLER (Pass 3) correct PAGE 0020 E/A GROM <0358> EA5B BE,73,7E GE848 ST >7E,@SUBSTK <0359> EA5E 08 FMT <0360> EA5F FE,00 ROW 0 <0361> EA61 FF,02 COL 2 <0362> EA63 06,2A,20 HTEX '* RUN *' EA66 52,55,4E EA69 20,2A <0363> EA6B A1 ROW+ 2 <0364> EA6C FF,02 COL 2 <0365> EA6E 0C,50,52 HTEX 'PROGRAM NAME?' EA71 4F,47,52 EA74 41,4D,20 EA77 4E,41,4D EA7A 45,3F <0366> EA7C FB FEND <0367> EA7D 06,E6,BA CALL EXPMEM <0368> EA80 86,42 CLR @XTOKEN <0369> EA82 BF,06,00 DST 194,@>8306 * Screen location LOCATION EA85 C2 <0370> EA86 BF,08,3F DST >3FF8,@>8308 * Locataion of LINK TABLE EA89 F8 <0371> EA8A BD,02,08 FNDLNK DST @>8308,@>8302 * Copy it. <0372> EA8D BE,04,06 ST 6,@>8304 * Length of each name. <0373> EA90 CA,CF,7D FNDLP CHE 128,@0(@>8302) * ~? EA93 00,02,80 <0374> EA96 6A,ED BS FNDDON * Yes, done. <0375> EA98 CA,CF,7D CHE 32,@0(@>8302) * Space or higher? EA9B 00,02,20 <0376> EA9E 4A,ED BR FNDDON * No, done. <0377> EAA0 D6,CF,7D CEQ 32,@0(@>8302) * Space? EAA3 00,02,20 <0378> EAA6 4A,AD BR FNDSHO * No. <0379> EAA8 D6,04,06 CEQ 6,@>8304 * 6? <0380> EAAB 6A,ED BS FNDDON * Yes. <0381> EAAD BC,E0,00 FNDSHO ST @0(@>8302),V@0(@>8306) EAB0 06,CF,7D EAB3 00,02 <0382> EAB5 91,06 DINC @>8306 * COL+1 <0383> EAB7 CB,06,03 DCHE 768,@>8306 * End of screen? EABA 00 <0384> EABB 4A,DC BR MORSCN <0385> EABD 31,00,14 MOVE 20,G@OUTSCN,V@>8 EAC0 A0,08,EA EAC3 CA <0386> EAC4 06,00,36 CALL BADTON <0387> EAC7 05,EA,ED B FNDDON <0388> EACA 2A,20,37 OUTSCN TEXT '* 72 NAMES SHOWN *' EACD 32,20,4E EAD0 41,4D,45 EAD3 53,20,53 EAD6 48,4F,57 EAD9 4E,20,2A <0389> EADC 91,02 MORSCN DINC @>8302 * Next character. <0390> EADE 92,04 DEC @>8304 * Length-1 <0391> EAE0 4A,90 BR FNDLP * No, keep looping. <0392> EAE2 95,06 DINCT @>8306 * Reset next column <0393> EAE4 A7,08,00 DSUB 8,@>8308 * Link Table Address+8 EAE7 08 <0394> EAE8 D6,08,00 CEQ >2600,@>8308 * Last Table name? <0395> EAEB 4A,8A BR FNDLNK * No <0396> EAED BF,20,00 FNDDON DST 130,@CURADD * Yes, screen input address EAF0 82 <0397> EAF1 B6,48,04 OR >04,@FLAG <0398> EAF4 06,E5,8B CALL GETINP 99/4 GPL-ASSEMBLER (Pass 3) correct PAGE 0021 E/A GROM <0399> EAF7 8F,50 DCZ @FAC6 <0400> EAF9 6B,11 BS GE883 <0401> EAFB BD,20,4E DST @FAC4,@CURADD <0402> EAFE C7,50,00 DCH >0006,@FAC6 EB01 06 <0403> EB02 6B,CB BS GE944 <0404> EB04 BE,4A,20 ST SPACE,@FAC <0405> EB07 35,00,05 MOVE 5,@FAC,@FAC1 EB0A 4B,4A <0406> EB0C 34,50,4A MOVE @FAC6,V*CURADD,@FAC EB0F B0,20 <0407> EB11 D7,8F,9D GE883 DCEQ >A55A,@>2000 EB14 00,A5,5A <0408> EB17 4B,9D BR GE916 <0409> EB19 06,E6,FA CALL USSCRN <0410> EB1C 87,22 GE88E DCLR @CODE <0411> EB1E 0F,21 XML >21 <0412> EB20 6B,6F BS GE8E3 <0413> EB22 DA,49,20 CLOG >20,@FLAG2 <0414> EB25 6B,31 BS GE8A3 <0415> EB27 94,73 INCT @SUBSTK <0416> EB29 BF,90,73 DST GE88E,*SUBSTK EB2C EB,1C <0417> EB2E 94,73 INCT @SUBSTK <0418> EB30 00 RTN <0419> EB31 05,EB,34 GE8A3 B GE8A8 <0420> EB34 06,E6,E1 GE8A8 CALL EASCRN <0421> EB37 06,EC,C4 CALL WENTER <0422> EB3A 40,3B BR GE029 <0423> EB3C 06,E6,E1 GE8B0 CALL EASCRN <0424> EB3F 06,EB,88 GE8B3 CALL GE8FC <0425> EB42 CA,22,08 CHE >08,@CODE <0426> EB45 4B,E4 BR CHKERR <0427> EB47 A6,22,08 SUB >08,@CODE <0428> EB4A C6,22,05 CH >05,@CODE <0429> EB4D 6B,60 BS GE8D4 <0430> EB4F 06,EC,30 CALL CLSALL <0431> EB52 8A,22 CASE @CODE <0432> EB54 4B,96 BR GE90F <0433> EB56 4B,8F BR GE908 <0434> EB58 4B,AF BR GE928 <0435> EB5A 4B,B6 BR GE92F <0436> EB5C 4B,BD BR GE936 <0437> EB5E 4B,C4 BR GE93D <0438> EB60 DA,48,20 GE8D4 CLOG >20,@FLAG <0439> EB63 49,84 BR GE767 <0440> EB65 DA,49,01 CLOG >01,@FLAG2 <0441> EB68 49,E4 BR LANDR <0442> EB6A 06,EC,4D CALL CLSPAB <0443> EB6D 42,46 BR EDITOR <0444> EB6F 06,EB,88 GE8E3 CALL GE8FC <0445> EB72 06,E6,E1 CALL EASCRN <0446> EB75 D6,22,0F CEQ >0F,@CODE <0447> EB78 4B,81 BR GE8F5 <0448> EB7A 06,EC,6D CALL ERRMSG <0449> EB7D ED,B2 DATA ERRPNF <0450> EB7F 4B,D0 BR GE949 <0451> EB81 06,EC,6D GE8F5 CALL ERRMSG <0452> EB84 ED,48 DATA ERRC <0453> EB86 40,3B BR GE029 <0454> EB88 39,00,01 GE8FC MOVE 1,G@GE271,#1 EB8B 01,E3,DB <0455> EB8E 00 GE907 RTN <0456> EB8F 06,EC,61 GE908 CALL WRNMSG 99/4 GPL-ASSEMBLER (Pass 3) correct PAGE 0022 E/A GROM <0457> EB92 ED,53 DATA CCRMSG <0458> EB94 4B,60 BR GE8D4 <0459> EB96 06,EC,6D GE90F CALL ERRMSG <0460> EB99 ED,0B DATA ERRMF <0461> EB9B 4B,60 BR GE8D4 <0462> EB9D 06,EC,6D GE916 CALL ERRMSG <0463> EBA0 ED,B2 DATA ERRPNF <0464> EBA2 40,28 BR OLDEA <0465> EBA4 DA,48,08 GE91D CLOG >08,@FLAG <0466> EBA7 4B,A9 BR GE9E2 <0467> EBA9 06,EC,6D GE9E2 CALL ERRMSG <0468> EBAC ED,26 DATA ERRNME <0469> EBAE 0B EXIT <0470> EBAF 06,EC,6D GE928 CALL ERRMSG <0471> EBB2 ED,6D DATA ERRIT <0472> EBB4 49,E4 BR LANDR <0473> EBB6 06,EC,6D GE92F CALL ERRMSG <0474> EBB9 ED,79 DATA ERRCE <0475> EBBB 49,E4 BR LANDR <0476> EBBD 06,EC,6D GE936 CALL ERRMSG <0477> EBC0 ED,88 DATA ERRDD <0478> EBC2 49,E4 BR LANDR <0479> EBC4 06,EC,6D GE93D CALL ERRMSG <0480> EBC7 ED,9D DATA ERRUR <0481> EBC9 49,E4 BR LANDR <0482> EBCB 06,EC,6D GE944 CALL ERRMSG <0483> EBCE ED,3A DATA ERRNTL <0484> EBD0 8F,50 GE949 DCZ @FAC6 <0485> EBD2 6B,DF BS GE958 <0486> EBD4 BE,B0,4E ST SPACE,V*FAC4 EBD7 20 <0487> EBD8 34,50,E0 MOVE @FAC6,V*FAC4,V@>0001(@FAC4) EBDB 01,4E,B0 EBDE 4E <0488> EBDF 06,EC,D4 GE958 CALL CLRMSG <0489> EBE2 4A,5B BR GE848 [0006] *********************************************************** [0007] COPY 'DSK5.MYXB7-C' <0001> EBE4 8E,44 CHKERR CZ @>8344 * Check Search flag <0002> EBE6 6B,EF BS CHKER2 * Yes, normal error <0003> EBE8 90,44 INC @>8344 * Drive # + 1 <0004> EBEA D6,44,3A CEQ 58,@>8344 * Last drive? <0005> EBED 47,8C BR MYSRCH * No, continue Search <0006> EBEF BC,4E,E0 CHKER2 ST V@>0001(@PABPTR),@FAC4 EBF2 01,1C <0007> EBF4 B2,4E,E0 AND >E0,@FAC4 <0008> EBF7 E6,4E,05 SRL >05,@FAC4 <0009> EBFA B6,4E,30 OR >30,@FAC4 <0010> EBFD B2,E0,01 AND >1F,V@>0001(@PABPTR) EC00 1C,1F <0011> EC02 D6,4E,35 CEQ >35,@FAC4 Error Read past EOF <0012> EC05 4C,0D BR GE97A <0013> EC07 06,EC,30 CALL CLSALL <0014> EC0A 05,E2,46 B EDITOR <0015> EC0D 06,EC,6D GE97A CALL ERRMSG <0016> EC10 ED,17 DATA ERRIOC <0017> EC12 D6,47,01 CEQ 1,@LDFLAG <0018> EC15 62,46 BS EDITOR <0019> EC17 D6,47,02 CEQ 2,@LDFLAG <0020> EC1A 68,2D BS ASSEM <0021> EC1C 06,EC,30 GE97F CALL CLSALL <0022> EC1F DA,48,20 CLOG >20,@FLAG <0023> EC22 40,28 BR OLDEA <0024> EC24 DA,49,01 CLOG >01,@FLAG2 99/4 GPL-ASSEMBLER (Pass 3) correct PAGE 0023 E/A GROM <0025> EC27 49,E4 BR LANDR <0026> EC29 DA,49,08 CLOG >08,@FLAG2 <0027> EC2C 40,28 BR OLDEA <0028> EC2E 42,46 BR EDITOR <0029> EC30 BF,1C,10 CLSALL DST >1000,@PABPTR EC33 00 <0030> EC34 06,EC,4D CALL CLSPAB <0031> EC37 BF,1C,11 DST >1100,@PABPTR EC3A 00 <0032> EC3B 06,EC,4D CALL CLSPAB <0033> EC3E BF,1C,12 DST >1200,@PABPTR EC41 00 <0034> EC42 06,EC,4D CALL CLSPAB <0035> EC45 BF,1C,13 DST >1300,@PABPTR EC48 00 <0036> EC49 06,EC,4D CALL CLSPAB <0037> EC4C 00 RTN <0038> EC4D BD,56,1C CLSPAB DST @PABPTR,@VPAB <0039> EC50 A3,56,00 DADD >0009,@VPAB EC53 09 <0040> EC54 BE,B0,1C ST >01,V*PABPTR EC57 01 <0041> EC58 06,00,10 CALL DSRLNK <0042> EC5B 08 BYTE >08 <0043> EC5C 86,E0,09 CLR V@>0009(@PABPTR) EC5F 1C <0044> EC60 00 RTN <0045> EC61 06,EC,D4 WRNMSG CALL CLRMSG <0046> EC64 31,00,0B MOVE 11,G@WARN,V@>02A2 EC67 A2,A2,ED EC6A 00 <0047> EC6B 4C,77 BR GE9DA <0048> EC6D 06,EC,D4 ERRMSG CALL CLRMSG <0049> EC70 31,00,09 MOVE 9,G@ERROR,V@>02A2 EC73 A2,A2,EC EC76 E0 <0050> EC77 88,4A GE9DA FETCH @FAC <0051> EC79 88,4B FETCH @FAC1 <0052> EC7B 86,4C CLR @FAC2 <0053> EC7D 33,00,01 MOVE 1,G@G0000(@FAC),@FAC3 EC80 4D,00,00 EC83 4A <0054> EC84 32,4C,A2 MOVE @FAC2,G@G0001(@FAC),V@>02C2 EC87 C2,00,01 EC8A 4A <0055> EC8B D7,4A,ED DCEQ ERRIOC,@FAC EC8E 17 <0056> EC8F 4C,95 BR GE9F8 <0057> EC91 BC,A2,D2 ST @FAC4,V@>02D2 EC94 4E <0058> EC95 D7,4A,ED GE9F8 DCEQ ERRC,@FAC EC98 48 <0059> EC99 4C,C4 BR WENTER <0060> EC9B E7,22,00 DSRL >0004,@CODE EC9E 04 <0061> EC9F E6,23,04 SRL >04,@>8323 <0062> ECA2 C6,22,09 CH >09,@CODE <0063> ECA5 4C,AF BR GEA12 <0064> ECA7 C6,22,0F CH >0F,@CODE <0065> ECAA 6C,C4 BS WENTER <0066> ECAC A2,22,07 ADD >07,@CODE <0067> ECAF C6,23,09 GEA12 CH >09,@>8323 <0068> ECB2 4C,BC BR GEA1F <0069> ECB4 C6,23,0F CH >0F,@>8323 99/4 GPL-ASSEMBLER (Pass 3) correct PAGE 0024 E/A GROM <0070> ECB7 6C,C4 BS WENTER <0071> ECB9 A2,23,07 ADD >07,@>8323 <0072> ECBC A3,22,30 GEA1F DADD >3030,@CODE ECBF 30 <0073> ECC0 BD,A2,D0 DST @CODE,V@>02D0 ECC3 22 <0074> * Wait for ENTER <0075> ECC4 31,00,17 WENTER MOVE 23,G@PRESS,V@>02E2 ECC7 A2,E2,EC ECCA E9 <0076> ECCB 03 GEA2E SCAN <0077> ECCC 4C,CB BR GEA2E <0078> ECCE D6,75,0D CEQ >0D,@KEY <0079> ECD1 4C,CB BR GEA2E <0080> ECD3 00 RTN <0081> ECD4 BE,A2,A0 CLRMSG ST SPACE,V@>02A0 ECD7 20 <0082> ECD8 35,00,5F MOVE >005F,V@>02A0,V@>02A1 ECDB A2,A1,A2 ECDE A0 <0083> ECDF 00 RTN <0084> ECE0 2A,20,45 ERROR TEXT '* ERROR *' ECE3 52,52,4F ECE6 52,20,2A <0085> ECE9 50,72,65 PRESS TEXT 'Press ENTER to continue' ECEC 73,73,20 ECEF 45,4E,54 ECF2 45,52,20 ECF5 74,6F,20 ECF8 63,6F,6E ECFB 74,69,6E ECFE 75,65 <0086> ED00 2A,20,57 WARN TEXT '* WARNING *' ED03 41,52,4E ED06 49,4E,47 ED09 20,2A <0087> ED0B 0B,4D,45 ERRMF STRI 'MEMORY FULL' ED0E 4D,4F,52 ED11 59,20,46 ED14 55,4C,4C <0088> ED17 0E,49,2F ERRIOC STRI 'I/O ERROR CODE' ED1A 4F,20,45 ED1D 52,52,4F ED20 52,20,43 ED23 4F,44,45 <0089> ED26 13,4E,4F ERRNME STRI 'NO MEMORY EXPANSION' ED29 20,4D,45 ED2C 4D,4F,52 ED2F 59,20,45 ED32 58,50,41 ED35 4E,53,49 ED38 4F,4E <0090> ED3A 0D,4E,41 ERRNTL STRI 'NAME TOO LONG' ED3D 4D,45,20 ED40 54,4F,4F ED43 20,4C,4F ED46 4E,47 <0091> ED48 0A,45,52 ERRC STRI 'ERROR CODE' ED4B 52,4F,52 ED4E 20,43,4F ED51 44,45 <0092> ED53 19,43,4F CCRMSG STRI 'CONTROL CHARACTER REMOVED' ED56 4E,54,52 ED59 4F,4C,20 99/4 GPL-ASSEMBLER (Pass 3) correct PAGE 0025 E/A GROM ED5C 43,48,41 ED5F 52,41,43 ED62 54,45,52 ED65 20,52,45 ED68 4D,4F,56 ED6B 45,44 <0093> ED6D 0B,49,4C ERRIT STRI 'ILLEGAL TAG' ED70 4C,45,47 ED73 41,4C,20 ED76 54,41,47 <0094> ED79 0E,43,48 ERRCE STRI 'CHECKSUM ERROR' ED7C 45,43,4B ED7F 53,55,4D ED82 20,45,52 ED85 52,4F,52 <0095> ED88 14,44,55 ERRDD STRI 'DUPLICATE DEFINITION' ED8B 50,4C,49 ED8E 43,41,54 ED91 45,20,44 ED94 45,46,49 ED97 4E,49,54 ED9A 49,4F,4E <0096> ED9D 14,55,4E ERRUR STRI 'UNRESOLVED REFERENCE' EDA0 52,45,53 EDA3 4F,4C,56 EDA6 45,44,20 EDA9 52,45,46 EDAC 45,52,45 EDAF 4E,43,45 <0097> EDB2 11,50,52 ERRPNF STRI 'PROGRAM NOT FOUND' EDB5 4F,47,52 EDB8 41,4D,20 EDBB 4E,4F,54 EDBE 20,46,4F EDC1 55,4E,44 <0098> EDC4 FF,FF,FF CUREDP BYTE >FF,>FF,>FF,>FF,>FF,>FF,>FF,>FF EDC7 FF,FF,FF EDCA FF,FF <0099> EDCC 81,00,00 CURPAT BYTE >81,>00,>00,>00,>00,>00,>00,>81 EDCF 00,00,00 EDD2 00,81 <0100> EDD4 84,00,00 BYTE >84,>00,>00,>00,>00,>00,>00,>84 EDD7 00,00,00 EDDA 00,84 <0101> EDDC E0,00,0E VREGS BYTE >E0,>00,>0E,>01,>06,>00 EDDF 01,06,00 <0102> * <0103> * CALL INIT <0104> * <0105> EDE2 D7,8F,9D BINIT2 DCEQ >A55A,@>2000 EDE5 00,A5,5A <0106> EDE8 6E,11 BS GEBBD <0107> EDEA 06,E6,BA BINIT3 CALL EXPMEM <0108> EDED BE,4A,03 ST >03,@FAC <0109> EDF0 BF,4C,EF DST GF000,@FAC2 EDF3 94 <0110> EDF4 33,00,04 GEBA0 MOVE 4,G@G0000(@FAC2),@FAC4 EDF7 4E,00,00 EDFA 4C <0111> EDFB A3,4C,00 DADD >0004,@FAC2 EDFE 04 <0112> EDFF 32,4E,CF MOVE @FAC4,G@G0000(@FAC2),@0(@FAC6) EE02 7D,00,50 EE05 00,00,4C 99/4 GPL-ASSEMBLER (Pass 3) correct PAGE 0026 E/A GROM <0113> EE08 A1,4C,4E DADD @FAC4,@FAC2 <0114> EE0B 92,4A DEC @FAC <0115> EE0D 4D,F4 BR GEBA0 <0116> EE0F 47,08 BR CLRXOP <0117> EE11 00 GEBBD RTN <0118> <0119> EE12 41,53,53 DASSM1 TEXT 'ASSM1' EE15 4D,31 <0120> EE17 55,54,49 DUTIL1 TEXT 'UTIL1' EE1A 4C,31 <0121> EE1C 0D BYTE >0D <0122> EE1D 4C,4F,41 DLOAD TEXT 'LOAD' EE20 44 <0123> EE21 0D BYTE >0D <0124> * NEW PATCH STUFF ***************************************** <0125> <0126> EE22 86,AF,10 BUGS CLR V@>1000 * CLEAR PAB AREAS EE25 00 <0127> EE26 35,03,80 MOVE >0380,V@>1000,V@>1001 EE29 AF,10,01 EE2C AF,10,00 <0128> EE2F B2,80,C2 AND >EF,@>83C2 EE32 EF <0129> EE33 00 RTN <0130> ******************************* <0131> EE34 86,4A CLRFAC CLR @FAC <0132> EE36 35,00,07 MOVE 7,@FAC,@FAC1 EE39 4B,4A <0133> EE3B 00 RTN <0134> ******************************* <0135> EE3C 06,E6,BA DEVICE CALL EXPMEM Clear expansion memory <0136> EE3F 35,00,80 MOVE 128,V@>027F,V@>0280 EE42 A2,80,A2 EE45 7F <0137> EE46 BC,06,75 ST @KEY,@>8306 Save key <0138> EE49 08 FMT <0139> EE4A FE,10 ROW 16 <0140> EE4C FF,02 COL 2 <0141> EE4E 0B,53,65 HTEX 'Select DSK#.' EE51 6C,65,63 EE54 74,20,44 EE57 53,4B,23 EE5A 2E <0142> EE5B FB FEND <0143> EE5C 35,00,05 MOVE 5,V@>100F,V@>020E EDIT1 or ASSM1 EE5F A2,0E,AF EE62 10,0F <0144> EE64 03 DEV1 SCAN KEY? <0145> EE65 4E,64 BR DEV1 No. <0146> EE67 D6,75,20 CEQ SPACE,@KEY SPACE BAR? <0147> EE6A 6E,81 BS DEV4 Yes <0148> EE6C D6,75,0F CEQ BACK,@KEY BACK? <0149> EE6F 6E,80 BS DEV3 Yes <0150> EE71 BC,A2,0C ST @KEY,V@>020C Any other key SAVE EE74 75 <0151> EE75 BC,AF,10 ST @KEY,V@>100D Put into PAB EE78 0D,75 <0152> EE7A BC,75,06 DEVNO ST @>8306,@KEY Restore old key <0153> EE7D 06,E7,D1 DEV2 CALL PMSG PLEASE WAIT... <0154> EE80 00 DEV3 RTN <0155> EE81 08 DEV4 FMT <0156> EE82 FE,10 ROW 16 <0157> EE84 FF,02 COL 2 <0158> EE86 10,45,78 HTEX 'Example: WDS1.EA.' 99/4 GPL-ASSEMBLER (Pass 3) correct PAGE 0027 E/A GROM EE89 61,6D,70 EE8C 6C,65,3A EE8F 20,57,44 EE92 53,31,2E EE95 45,41,2E <0159> EE98 FE,12 ROW 18 <0160> EE9A FF,02 COL 2 <0161> EE9C 0E,46,55 HTEX 'FULL PATH NAME?' EE9F 4C,4C,20 EEA2 50,41,54 EEA5 48,20,4E EEA8 41,4D,45 EEAB 3F <0162> EEAC FB FEND <0163> EEAD 35,00,05 MOVE 5,V@>100F,V@>0213 EDIT1 or ASSM1 EEB0 A2,13,AF EEB3 10,0F <0164> EEB5 BF,20,02 DST >0282,@CURADD EEB8 82 <0165> EEB9 86,44 CLR @>8344 Clear search flag <0166> EEBB B6,48,04 OR >04,@FLAG Set return flag <0167> EEBE 06,E5,8B CALL GETINP <0168> EEC1 BD,00,20 DST @CURADD,@>8300 <0169> EEC4 A6,01,82 SUB >82,@>8301 <0170> EEC7 BC,AF,10 ST @>8301,V@>1009 EECA 09,01 <0171> EECC 34,00,AF MOVE @>8300,V@>0282,V@>100A EECF 10,0A,A2 EED2 82 <0172> EED3 BE,48,20 ST >20,@FLAG <0173> EED6 05,EE,7A B DEVNO <0174> ******************************************** <0175> EED9 07,20 XBINP ALL SPACE <0176> EEDB BE,4A,01 ST 1,@FAC <0177> EEDE 08 XBAGN FMT <0178> EEDF FF,08 COL 8 <0179> EEE1 FE,01 ROW 1 <0180> EEE3 08,2A,20 HTEX '* R X B *' EEE6 52,20,58 EEE9 20,42,20 EEEC 2A <0181> EEED A3 ROW+ 4 <0182> EEEE FF,02 COL 2 <0183> EEF0 09,46,49 HTEX 'FILE NAME?' EEF3 4C,45,20 EEF6 4E,41,4D EEF9 45,3F <0184> EEFB FB FEND <0185> EEFC 92,4A DEC @FAC <0186> EEFE 4E,DE BR XBAGN <0187> EF00 D6,42,FF CEQ >FF,@XTOKEN <0188> EF03 4F,11 BR XBINP1 <0189> EF05 35,00,40 MOVE 64,V@>2400,V@>2255 EF08 AF,22,55 EF0B AF,24,00 <0190> EF0E BE,42,EA ST >EA,@XTOKEN <0191> EF11 BF,20,01 XBINP1 DST >0102,@CURADD EF14 02 <0192> EF15 BF,1C,10 DST >1000,@PABPTR EF18 00 <0193> EF19 B6,48,20 OR >20,@FLAG <0194> EF1C 06,E5,1D CALL GETALL <0195> EF1F 8F,50 DCZ @FAC6 <0196> EF21 6F,5B BS XBINP3 99/4 GPL-ASSEMBLER (Pass 3) correct PAGE 0028 E/A GROM <0197> EF23 D6,51,01 CEQ 1,@FAC7 <0198> EF26 4F,49 BR XBINP2 <0199> EF28 BF,AF,24 DST >000A,V@>2400 EF2B 00,00,0A <0200> EF2E 31,00,05 MOVE 5,G@DDSK1,V@>2402 EF31 AF,24,02 EF34 E8,23 <0201> EF36 BC,AF,24 ST V*STLN,V@>2405 EF39 05,B0,24 <0202> EF3C 31,00,05 MOVE 5,G@DLOAD,V@>2407 EF3F AF,24,07 EF42 EE,1D <0203> EF44 BE,42,FF ST >FF,@XTOKEN <0204> EF47 4E,D9 BR XBINP <0205> EF49 06,EF,65 XBINP2 CALL CLRREA <0206> EF4C BF,AF,22 DST >994A,V@>2254 EF4F 54,99,4A <0207> EF52 35,00,50 MOVE 80,V@9(@PABPTR),V@>2256 EF55 AF,22,56 EF58 E0,09,1C <0208> EF5B 86,00 XBINP3 CLR @>8300 <0209> EF5D 35,00,6E MOVE >006E,@>8300,@>8301 EF60 01,00 <0210> EF62 05,63,72 B RXB <0211> ******************************************** <0212> EF65 86,AF,22 CLRREA CLR V@>2250 EF68 50 <0213> EF69 35,00,50 MOVE 80,V@>2250,V@>2251 EF6C AF,22,51 EF6F AF,22,50 <0214> EF72 00 RTN <0215> EF73 D6,E0,09 ONEKEY CEQ 1,V@9(@PABPTR) One character for drive#? EF76 1C,01 <0216> EF78 4F,93 BR TWOKEY No, normal continue <0217> EF7A BC,80,C0 ST V@10(@PABPTR),@>83C0 Yes, save # character EF7D E0,0A,1C <0218> EF80 31,00,05 MOVE 5,G@DDSK1,V@10(@PABPTR) DSK1. loaded into pab EF83 E0,0A,1C EF86 E8,23 <0219> EF88 BE,E0,09 ST >05,V@9(@PABPTR) DSK1. has 5 characters EF8B 1C,05 <0220> EF8D BC,E0,0D ST @>83C0,V@13(@PABPTR) Load charcter drive#/le EF90 1C,80,C0 <0221> EF93 00 TWOKEY RTN <0222> *********************************************************** <0223> * <0224> * Data for Initialization of <0225> * Memory Expansion <0226> * <0227> EF94 00,08,20 GF000 DATA >0008,>2000,>A55A,>2128,>2398,>225A,>0654 EF97 00,A5,5A EF9A 21,28,23 EF9D 98,22,5A EFA0 06,54 <0228> EFA2 20,22,00 DATA >2022,>0000,>A000,>FFD7,>2676,>3F38 EFA5 00,A0,00 EFA8 FF,D7,26 EFAB 76,3F,38 <0229> EFAE 00,00,00 DATA 0,0,0,0,0,0,0,0,0 EFB1 00,00,00 EFB4 00,00,00 EFB7 00,00,00 EFBA 00,00,00 EFBD 00,00,00 99/4 GPL-ASSEMBLER (Pass 3) correct PAGE 0029 E/A GROM <0230> EFC0 00,00,00 DATA 0,0,0,0,0,0,0,0 EFC3 00,00,00 EFC6 00,00,00 EFC9 00,00,00 EFCC 00,00,00 EFCF 00 <0231> EFD0 00,00,00 DATA 0,0,0,0,0,0,0 EFD3 00,00,00 EFD6 00,00,00 EFD9 00,00,00 EFDC 00,00 <0232> EFDE 00,00,00 DATA 0,0,0,0,0,0,0,0 EFE1 00,00,00 EFE4 00,00,00 EFE7 00,00,00 EFEA 00,00,00 EFED 00 <0233> EFEE 00,00,00 DATA 0,0,0,0,0,0,0 EFF1 00,00,00 EFF4 00,00,00 EFF7 00,00,00 EFFA 00,00 <0234> EFFC 00,00,00 DATA 0,0,0,0,0,0,0,0 EFFF 00,00,00 F002 00,00,00 F005 00,00,00 F008 00,00,00 F00B 00 <0235> F00C 00,00,00 DATA 0,0,0,0,0,0,0 F00F 00,00,00 F012 00,00,00 F015 00,00,00 F018 00,00 <0236> F01A 00,00,00 DATA 0,0,0,0,0,0,0,0 F01D 00,00,00 F020 00,00,00 F023 00,00,00 F026 00,00,00 F029 00 <0237> F02A 00,00,00 DATA 0,0,0,0,0,0,0 F02D 00,00,00 F030 00,00,00 F033 00,00,00 F036 00,00 <0238> F038 00,00,00 DATA 0,0,0,0,0,0,0,0 F03B 00,00,00 F03E 00,00,00 F041 00,00,00 F044 00,00,00 F047 00 <0239> F048 00,00,00 DATA 0,0,0,0,0,0,0 F04B 00,00,00 F04E 00,00,00 F051 00,00,00 F054 00,00 <0240> F056 00,00,00 DATA 0,0,0,0,0,0,0,0 F059 00,00,00 F05C 00,00,00 F05F 00,00,00 F062 00,00,00 F065 00 <0241> F066 00,00,00 DATA 0,0,0,0,0,0,0 F069 00,00,00 F06C 00,00,00 99/4 GPL-ASSEMBLER (Pass 3) correct PAGE 0030 E/A GROM F06F 00,00,00 F072 00,00 <0242> F074 00,00,00 DATA 0,0,0,0,>0064,>2000,>2EAA,>2094 F077 00,00,00 F07A 00,00,00 F07D 64,20,00 F080 2E,AA,20 F083 94 <0243> F084 21,C4,20 DATA >21C4,>2094,>2196,>2094,>21DE,>2094,>21F4 F087 94,21,96 F08A 20,94,21 F08D DE,20,94 F090 21,F4 <0244> F092 20,94,22 DATA >2094,>2200,>2094,>220E,>2094,>221A,>2094,>2228 F095 00,20,94 F098 22,0E,20 F09B 94,22,1A F09E 20,94,22 F0A1 28 <0245> F0A2 20,9A,22 DATA >209A,>22B2,>20DA,>23BA,>C80B,>2030,>D060, F0A5 B2,20,DA F0A8 23,BA,C8 F0AB 0B,20,30 F0AE D0,60 <0246> F0B0 83,49,20 DATA >8349,>2060,>20FC,>132A,>C020,>8350,>1311,>06A0 F0B3 60,20,FC F0B6 13,2A,C0 F0B9 20,83,50 F0BC 13,11,06 F0BF A0 <0247> F0C0 26,46,10 DATA >2646,>101E,>0281,>3F38,>1319,>C001,>0202 F0C3 1E,02,81 F0C6 3F,38,13 F0C9 19,C0,01 F0CC 02,02 <0248> F0CE 83,4A,8C DATA >834A,>8CB0,>1611,>8CB0,>160F,>8CB0,>160D,>C810 F0D1 B0,16,11 F0D4 8C,B0,16 F0D7 0F,8C,B0 F0DA 16,0D,C8 F0DD 10 <0249> F0DE 20,22,02 DATA >2022,>02E0,>20BA,>C020,>2022,>1309,>0690 F0E1 E0,20,BA F0E4 C0,20,20 F0E7 22,13,09 F0EA 06,90 <0250> F0EC 02,E0,83 DATA >02E0,>83E0,>C2E0,>2030,>045B,>0221,>0008,>10E4 F0EF E0,C2,E0 F0F2 20,30,04 F0F5 5B,02,21 F0F8 00,08,10 F0FB E4 <0251> F0FC 02,00,0F DATA >0200,>0F00,>D800,>8322,>02E0,>83E0,>0460 F0FF 00,D8,00 F102 83,22,02 F105 E0,83,E0 F108 04,60 <0252> F10A 00,CE,58 DATA >00CE,>5820,>20FC,>8349,>02E0,>2094,>0380,>C83E F10D 20,20,FC F110 83,49,02 F113 E0,20,94 F116 03,80,C8 F119 3E <0253> F11A 83,E2,02 DATA >83E2,>02E0,>83E0,>C80B,>20AA,>C081,>0281 99/4 GPL-ASSEMBLER (Pass 3) correct PAGE 0031 E/A GROM F11D E0,83,E0 F120 C8,0B,20 F123 AA,C0,81 F126 02,81 <0254> F128 80,00,1B DATA >8000,>1B07,>09C1,>0A11,>0A42,>09B2,>A0A1,>0CFA F12B 07,09,C1 F12E 0A,11,0A F131 42,09,B2 F134 A0,A1,0C F137 FA <0255> F138 C0,92,06 DATA >C092,>0692,>02E0,>2094,>C80B,>83F6,>0380 F13B 92,02,E0 F13E 20,94,C8 F141 0B,83,F6 F144 03,80 <0256> F146 D0,60,83 DATA >D060,>8373,>0981,>C87E,>8304,>F820,>20FC,>8349 F149 73,09,81 F14C C8,7E,83 F14F 04,F8,20 F152 20,FC,83 F155 49 <0257> F156 02,E0,83 DATA >02E0,>83E0,>C2E0,>2030,>045B,>02E0,>83E0 F159 E0,C2,E0 F15C 20,30,04 F15F 5B,02,E0 F162 83,E0 <0258> F164 C8,0B,20 DATA >C80B,>20AA,>06A0,>000E,>02E0,>2094,>C80B,>83F6 F167 AA,06,A0 F16A 00,0E,02 F16D E0,20,94 F170 C8,0B,83 F173 F6 <0259> F174 03,80,06 DATA >0380,>06A0,>223A,>D82D,>0002,>8C00,>0380 F177 A0,22,3A F17A D8,2D,00 F17D 02,8C,00 F180 03,80 <0260> F182 06,A0,22 DATA >06A0,>223A,>D831,>8C00,>0602,>16FC,>0380,>06A0 F185 3A,D8,31 F188 8C,00,06 F18B 02,16,FC F18E 03,80,06 F191 A0 <0261> F192 22,40,DB DATA >2240,>DB60,>8800,>0002,>0380,>06A0,>2240 F195 60,88,00 F198 00,02,03 F19B 80,06,A0 F19E 22,40 <0262> F1A0 DC,60,88 DATA >DC60,>8800,>0602,>16FC,>0380,>C05D,>D82D,>0001 F1A3 00,06,02 F1A6 16,FC,03 F1A9 80,C0,5D F1AC D8,2D,00 F1AF 01 <0263> F1B0 8C,02,02 DATA >8C02,>0261,>8000,>D801,>8C02,>0380,>0201 F1B3 61,80,00 F1B6 D8,01,8C F1B9 02,03,80 F1BC 02,01 <0264> F1BE 40,00,10 DATA >4000,>1001,>04C1,>C09D,>D820,>2099,>8C02,>E081 F1C1 01,04,C1 F1C4 C0,9D,D8 F1C7 20,20,99 F1CA 8C,02,E0 99/4 GPL-ASSEMBLER (Pass 3) correct PAGE 0032 E/A GROM F1CD 81 <0265> F1CE D8,02,8C DATA >D802,>8C02,>C06D,>0002,>C0AD,>0004,>045B F1D1 02,C0,6D F1D4 00,02,C0 F1D7 AD,00,04 F1DA 04,5B <0266> F1DC 02,04,83 DATA >0204,>834A,>C014,>C184,>04F6,>04F6,>C140,>1323 F1DF 4A,C0,14 F1E2 C1,84,04 F1E5 F6,04,F6 F1E8 C1,40,13 F1EB 23 <0267> F1EC 07,40,02 DATA >0740,>0203,>0040,>04F6,>04D6,>0280,>0064 F1EF 03,00,40 F1F2 04,F6,04 F1F5 D6,02,80 F1F8 00,64 <0268> F1FA 1A,13,02 DATA >1A13,>0280,>2710,>1A08,>0583,>C040,>04C0,>3C20 F1FD 80,27,10 F200 1A,08,05 F203 83,C0,40 F206 04,C0,3C F209 20 <0269> F20A 20,FA,D9 DATA >20FA,>D920,>83E3,>0003,>0583,>C040,>04C0 F20D 20,83,E3 F210 00,03,05 F213 83,C0,40 F216 04,C0 <0270> F218 3C,20,20 DATA >3C20,>20FA,>D920,>83E3,>0002,>D920,>83E1,>0001 F21B FA,D9,20 F21E 83,E3,00 F221 02,D9,20 F224 83,E1,00 F227 01 <0271> F228 D5,20,83 DATA >D520,>83E7,>0545,>1101,>0514,>045B,>C17E F22B E7,05,45 F22E 11,01,05 F231 14,04,5B F234 C1,7E <0272> F236 53,E0,20 DATA >53E0,>20FC,>C020,>8356,>C240,>0229,>FFF8,>0420 F239 FC,C0,20 F23C 83,56,C2 F23F 40,02,29 F242 FF,F8,04 F245 20 <0273> F246 21,14,D0 DATA >2114,>D0C1,>0983,>0704,>0202,>208C,>0580 F249 C1,09,83 F24C 07,04,02 F24F 02,20,8C F252 05,80 <0274> F254 05,84,80 DATA >0584,>80C4,>1306,>0420,>2114,>DC81,>9801,>20FE F257 C4,13,06 F25A 04,20,21 F25D 14,DC,81 F260 98,01,20 F263 FE <0275> F264 16,F6,C1 DATA >16F6,>C104,>1352,>0284,>0007,>154F,>04E0 F267 04,13,52 F26A 02,84,00 F26D 07,15,4F F270 04,E0 <0276> F272 83,D0,C8 DATA >83D0,>C804,>8354,>C804,>2036,>0584,>A804,>8356 F275 04,83,54 F278 C8,04,20 99/4 GPL-ASSEMBLER (Pass 3) correct PAGE 0033 E/A GROM F27B 36,05,84 F27E A8,04,83 F281 56 <0277> F282 C8,20,83 DATA >C820,>8356,>2038,>02E0,>83E0,>04C1,>020C F285 56,20,38 F288 02,E0,83 F28B E0,04,C1 F28E 02,0C <0278> F290 0F,00,C3 DATA >0F00,>C30C,>1301,>1E00,>022C,>0100,>04E0,>83D0 F293 0C,13,01 F296 1E,00,02 F299 2C,01,00 F29C 04,E0,83 F29F D0 <0279> F2A0 02,8C,20 DATA >028C,>2000,>1332,>C80C,>83D0,>1D00,>0202 F2A3 00,13,32 F2A6 C8,0C,83 F2A9 D0,1D,00 F2AC 02,02 <0280> F2AE 40,00,98 DATA >4000,>9812,>20FF,>16EE,>A0A0,>20A4,>1003,>C0A0 F2B1 12,20,FF F2B4 16,EE,A0 F2B7 A0,20,A4 F2BA 10,03,C0 F2BD A0 <0281> F2BE 83,D2,1D DATA >83D2,>1D00,>C092,>13E6,>C802,>83D2,>05C2 F2C1 00,C0,92 F2C4 13,E6,C8 F2C7 02,83,D2 F2CA 05,C2 <0282> F2CC C2,72,D1 DATA >C272,>D160,>8355,>1309,>9C85,>16F2,>0985,>0206 F2CF 60,83,55 F2D2 13,09,9C F2D5 85,16,F2 F2D8 09,85,02 F2DB 06 <0283> F2DC 20,8C,9C DATA >208C,>9CB6,>16ED,>0605,>16FC,>0581,>C801 F2DF B6,16,ED F2E2 06,05,16 F2E5 FC,05,81 F2E8 C8,01 <0284> F2EA 20,3A,C8 DATA >203A,>C809,>2034,>C80C,>2032,>0699,>10E2,>1E00 F2ED 09,20,34 F2F0 C8,0C,20 F2F3 32,06,99 F2F6 10,E2,1E F2F9 00 <0285> F2FA 02,E0,20 DATA >02E0,>209A,>C009,>0420,>2114,>09D1,>1604 F2FD 9A,C0,09 F300 04,20,21 F303 14,09,D1 F306 16,04 <0286> F308 03,80,02 DATA >0380,>02E0,>209A,>04C1,>06C1,>D741,>F3E0,>20FC F30B E0,20,9A F30E 04,C1,06 F311 C1,D7,41 F314 F3,E0,20 F317 FC <0287> F318 03,80,C8 DATA >0380,>C80B,>2030,>02E0,>20BA,>0420,>2124 F31B 0B,20,30 F31E 02,E0,20 F321 BA,04,20 F324 21,24 <0288> F326 02,E0,83 DATA >02E0,>83E0,>1303,>C2E0,>2030,>045B,>D820,>20BA 99/4 GPL-ASSEMBLER (Pass 3) correct PAGE 0034 E/A GROM F329 E0,13,03 F32C C2,E0,20 F32F 30,04,5B F332 D8,20,20 F335 BA <0289> F336 83,22,04 DATA >8322,>0460,>00CE,>04E0,>2022,>53E0,>20FC F339 60,00,CE F33C 04,E0,20 F33F 22,53,E0 F342 20,FC <0290> F344 C0,20,83 DATA >C020,>8356,>0420,>2120,>0008,>1332,>0220,>FFF7 F347 56,04,20 F34A 21,20,00 F34D 08,13,32 F350 02,20,FF F353 F7 <0291> F354 02,01,02 DATA >0201,>0200,>0420,>210C,>0580,>C800,>202E F357 00,04,20 F35A 21,0C,05 F35D 80,C8,00 F360 20,2E <0292> F362 C1,E0,20 DATA >C1E0,>2024,>C147,>04CC,>06A0,>25E0,>0283,>0001 F365 24,C1,47 F368 04,CC,06 F36B A0,25,E0 F36E 02,83,00 F371 01 <0293> F372 16,24,05 DATA >1624,>058C,>04C3,>1023,>0283,>0046,>161E F375 8C,04,C3 F378 10,23,02 F37B 83,00,46 F37E 16,1E <0294> F380 04,C2,06 DATA >04C2,>06A0,>262E,>0283,>003A,>16F7,>C020,>202E F383 A0,26,2E F386 02,83,00 F389 3A,16,F7 F38C C0,20,20 F38F 2E <0295> F390 06,00,02 DATA >0600,>0201,>0100,>0420,>210C,>06A0,>25E0 F393 01,01,00 F396 04,20,21 F399 0C,06,A0 F39C 25,E0 <0296> F39E C0,20,20 DATA >C020,>2022,>1307,>06A0,>2646,>1005,>CB4E,>0016 F3A1 22,13,07 F3A4 06,A0,26 F3A7 46,10,05 F3AA CB,4E,00 F3AD 16 <0297> F3AE C3,A0,20 DATA >C3A0,>2022,>0380,>D740,>F3E0,>20FC,>0380 F3B1 22,03,80 F3B4 D7,40,F3 F3B7 E0,20,FC F3BA 03,80 <0298> F3BC 06,A0,25 DATA >06A0,>25C2,>04C4,>D123,>2662,>0974,>C808,>202C F3BF C2,04,C4 F3C2 D1,23,26 F3C5 62,09,74 F3C8 C8,08,20 F3CB 2C <0299> F3CC 06,A0,25 DATA >06A0,>2594,>0464,>23F8,>0580,>0240,>FFFE F3CF 94,04,64 F3D2 23,F8,05 F3D5 80,02,40 99/4 GPL-ASSEMBLER (Pass 3) correct PAGE 0035 E/A GROM F3D8 FF,FE <0300> F3DA C1,20,20 DATA >C120,>2024,>A100,>1808,>8804,>2026,>1B05,>C160 F3DD 24,A1,00 F3E0 18,08,88 F3E3 04,20,26 F3E6 1B,05,C1 F3E9 60 <0301> F3EA 20,24,C8 DATA >2024,>C804,>2024,>100A,>C120,>2028,>A100 F3ED 04,20,24 F3F0 10,0A,C1 F3F3 20,20,28 F3F6 A1,00 <0302> F3F8 88,04,20 DATA >8804,>202A,>140C,>C160,>2028,>C804,>2028,>C1C5 F3FB 2A,14,0C F3FE C1,60,20 F401 28,C8,04 F404 20,28,C1 F407 C5 <0303> F408 02,09,00 DATA >0209,>0008,>06A0,>262E,>0609,>16FC,>10B6 F40B 08,06,A0 F40E 26,2E,06 F411 09,16,FC F414 10,B6 <0304> F416 02,00,08 DATA >0200,>0800,>10CC,>A005,>C800,>2022,>10AF,>A800 F419 00,10,CC F41C A0,05,C8 F41F 00,20,22 F422 10,AF,A8 F425 00 <0305> F426 20,2C,13 DATA >202C,>13AC,>0200,>0B00,>10C2,>A005,>C1C0 F429 AC,02,00 F42C 0B,00,10 F42F C2,A0,05 F432 C1,C0 <0306> F434 10,A6,A0 DATA >10A6,>A005,>DDC0,>DDE0,>20DB,>10A1,>A005,>06A0 F437 05,DD,C0 F43A DD,E0,20 F43D DB,10,A1 F440 A0,05,06 F443 A0 <0307> F444 25,66,C0 DATA >2566,>C000,>1316,>0226,>FFF8,>8106,>1B02 F447 00,13,16 F44A 02,26,FF F44D F8,81,06 F450 1B,02 <0308> F452 05,14,10 DATA >0514,>1096,>8594,>16F8,>89A4,>0002,>0002,>16F4 F455 96,85,94 F458 16,F8,89 F45B A4,00,02 F45E 00,02,16 F461 F4 <0309> F462 89,A4,00 DATA >89A4,>0004,>0004,>16F0,>C0E6,>0006,>C250 F465 04,00,04 F468 16,F0,C0 F46B E6,00,06 F46E C2,50 <0310> F470 C4,03,C0 DATA >C403,>C009,>16FC,>0224,>0008,>C804,>202A,>10EA F473 09,16,FC F476 02,24,00 F479 08,C8,04 F47C 20,2A,10 F47F EA <0311> F480 A0,05,06 DATA >A005,>06A0,>2566,>0226,>FFF8,>8106,>13E3 F483 A0,25,66 99/4 GPL-ASSEMBLER (Pass 3) correct PAGE 0036 E/A GROM F486 02,26,FF F489 F8,81,06 F48C 13,E3 <0312> F48E C2,96,15 DATA >C296,>1501,>050A,>8294,>16F7,>89A4,>0002,>0002 F491 01,05,0A F494 82,94,16 F497 F7,89,A4 F49A 00,02,00 F49D 02 <0313> F49E 16,F3,89 DATA >16F3,>89A4,>0004,>0004,>16EF,>C296,>1516 F4A1 A4,00,04 F4A4 00,04,16 F4A7 EF,C2,96 F4AA 15,16 <0314> F4AC C0,E6,00 DATA >C0E6,>0006,>C253,>C4C0,>C0C9,>16FC,>C246,>6244 F4AF 06,C2,53 F4B2 C4,C0,C0 F4B5 C9,16,FC F4B8 C2,46,62 F4BB 44 <0315> F4BC C2,86,02 DATA >C286,>022A,>0008,>C0C6,>0643,>064A,>C693 F4BF 2A,00,08 F4C2 C0,C6,06 F4C5 43,06,4A F4C8 C6,93 <0316> F4CA 06,49,16 DATA >0649,>16FB,>0224,>0008,>C804,>202A,>10D9,>CB44 F4CD FB,02,24 F4D0 00,08,C8 F4D3 04,20,2A F4D6 10,D9,CB F4D9 44 <0317> F4DA 00,02,02 DATA >0002,>0200,>0C00,>0460,>2432,>0460,>2494 F4DD 00,0C,00 F4E0 04,60,24 F4E3 32,04,60 F4E6 24,94 <0318> F4E8 C2,8B,02 DATA >C28B,>0209,>0006,>C1A0,>202A,>0226,>FFF8,>C106 F4EB 09,00,06 F4EE C1,A0,20 F4F1 2A,02,26 F4F4 FF,F8,C1 F4F7 06 <0319> F4F8 88,06,20 DATA >8806,>2028,>1AF3,>C806,>202A,>06A0,>262E F4FB 28,1A,F3 F4FE C8,06,20 F501 2A,06,A0 F504 26,2E <0320> F506 DD,A0,20 DATA >DDA0,>20E1,>0609,>16FA,>C580,>0206,>4000,>045A F509 E1,06,09 F50C 16,FA,C5 F50F 80,02,06 F512 40,00,04 F515 5A <0321> F516 C2,8B,04 DATA >C28B,>04C0,>C30C,>1308,>06A0,>262E,>D020 F519 C0,C3,0C F51C 13,08,06 F51F A0,26,2E F522 D0,20 <0322> F524 20,E1,06 DATA >20E1,>06A0,>262E,>A003,>045A,>0209,>0004,>06A0 F527 A0,26,2E F52A A0,03,04 F52D 5A,02,09 F530 00,04,06 F533 A0 99/4 GPL-ASSEMBLER (Pass 3) correct PAGE 0037 E/A GROM <0323> F534 26,2E,06 DATA >262E,>06A0,>25C2,>0A40,>A003,>0609,>16F8 F537 A0,25,C2 F53A 0A,40,A0 F53D 03,06,09 F540 16,F8 <0324> F542 04,5A,02 DATA >045A,>0223,>FFD0,>0283,>000A,>1A05,>0223,>FFF9 F545 23,FF,D0 F548 02,83,00 F54B 0A,1A,05 F54E 02,23,FF F551 F9 <0325> F552 02,83,00 DATA >0283,>0019,>1B01,>045B,>0200,>0A00,>0460 F555 19,1B,01 F558 04,5B,02 F55B 00,0A,00 F55E 04,60 <0326> F560 24,32,02 DATA >2432,>02E0,>83E0,>0200,>2032,>C330,>C270,>C830 F563 E0,83,E0 F566 02,00,20 F569 32,C3,30 F56C C2,70,C8 F56F 30 <0327> F570 83,54,C8 DATA >8354,>C830,>8356,>C050,>1D00,>9820,>4000 F573 30,83,56 F576 C0,50,1D F579 00,98,20 F57C 40,00 <0328> F57E 20,FF,16 DATA >20FF,>161D,>0699,>101B,>1E00,>02E0,>20DA,>C020 F581 1D,06,99 F584 10,1B,1E F587 00,02,E0 F58A 20,DA,C0 F58D 20 <0329> F58E 20,2E,02 DATA >202E,>0201,>20DB,>0202,>0004,>0420,>2118 F591 01,20,DB F594 02,02,00 F597 04,04,20 F59A 21,18 <0330> F59C 70,00,09 DATA >7000,>0950,>1610,>0982,>C001,>0201,>203C,>0420 F59F 50,16,10 F5A2 09,82,C0 F5A5 01,02,01 F5A8 20,3C,04 F5AB 20 <0331> F5AC 21,18,04 DATA >2118,>04C8,>0602,>11D7,>D0F1,>0983,>A203 F5AF C8,06,02 F5B2 11,D7,D0 F5B5 F1,09,83 F5B8 A2,03 <0332> F5BA 04,5B,02 DATA >045B,>02E0,>20DA,>04C0,>06C0,>0460,>2432,>0201 F5BD E0,20,DA F5C0 04,C0,06 F5C3 C0,04,60 F5C6 24,32,02 F5C9 01 <0333> F5CA 3F,40,02 DATA >3F40,>0221,>FFF8,>C011,>1105,>8060,>202A F5CD 21,FF,F8 F5D0 C0,11,11 F5D3 05,80,60 F5D6 20,2A <0334> F5D8 16,F9,05 DATA >16F9,>05CB,>045B,>0200,>0D00,>045B,>2D52,>5163 F5DB CB,04,5B F5DE 02,00,0D F5E1 00,04,5B 99/4 GPL-ASSEMBLER (Pass 3) correct PAGE 0038 E/A GROM F5E4 2D,52,51 F5E7 63 <0335> F5E8 64,83,84 DATA >6483,>8455,>045C,>5B5F,>5EF0,>F003,>F0F0 F5EB 55,04,5C F5EE 5B,5F,5E F5F1 F0,F0,03 F5F4 F0,F0 <0336> F5F6 47,00,00 DATA >4700,>00C8,>3F38,>5554,>4C54,>4142,>2022,>5041 F5F9 C8,3F,38 F5FC 55,54,4C F5FF 54,41,42 F602 20,22,50 F605 41 <0337> F606 44,20,20 DATA >4420,>2020,>8300,>4750,>4C57,>5320,>83E0 F609 20,83,00 F60C 47,50,4C F60F 57,53,20 F612 83,E0 <0338> F614 53,4F,55 DATA >534F,>554E,>4420,>8400,>5644,>5052,>4420,>8800 F617 4E,44,20 F61A 84,00,56 F61D 44,50,52 F620 44,20,88 F623 00 <0339> F624 56,44,50 DATA >5644,>5053,>5441,>8802,>5644,>5057,>4420 F627 53,54,41 F62A 88,02,56 F62D 44,50,57 F630 44,20 <0340> F632 8C,00,56 DATA >8C00,>5644,>5057,>4120,>8C02,>5350,>4348,>5244 F635 44,50,57 F638 41,20,8C F63B 02,53,50 F63E 43,48,52 F641 44 <0341> F642 90,00,53 DATA >9000,>5350,>4348,>5754,>9400,>4752,>4D52 F645 50,43,48 F648 57,54,94 F64B 00,47,52 F64E 4D,52 <0342> F650 44,20,98 DATA >4420,>9800,>4752,>4D52,>4120,>9802,>4752,>4D57 F653 00,47,52 F656 4D,52,41 F659 20,98,02 F65C 47,52,4D F65F 57 <0343> F660 44,20,9C DATA >4420,>9C00,>4752,>4D57,>4120,>9C02,>5343 F663 00,47,52 F666 4D,57,41 F669 20,9C,02 F66C 53,43 <0344> F66E 41,4E,20 DATA >414E,>2020,>000E,>584D,>4C4C,>4E4B,>2104,>4B53 F671 20,00,0E F674 58,4D,4C F677 4C,4E,4B F67A 21,04,4B F67D 53 <0345> F67E 43,41,4E DATA >4341,>4E20,>2108,>5653,>4257,>2020,>210C F681 20,21,08 F684 56,53,42 F687 57,20,20 F68A 21,0C <0346> F68C 56,4D,42 DATA >564D,>4257,>2020,>2110,>5653,>4252,>2020,>2114 F68F 57,20,20 99/4 GPL-ASSEMBLER (Pass 3) correct PAGE 0039 E/A GROM F692 21,10,56 F695 53,42,52 F698 20,20,21 F69B 14 <0347> F69C 56,4D,42 DATA >564D,>4252,>2020,>2118,>5657,>5452,>2020 F69F 52,20,20 F6A2 21,18,56 F6A5 57,54,52 F6A8 20,20 <0348> F6AA 21,1C,44 DATA >211C,>4453,>524C,>4E4B,>2120,>4C4F,>4144,>4552 F6AD 53,52,4C F6B0 4E,4B,21 F6B3 20,4C,4F F6B6 41,44,45 F6B9 52 <0349> F6BA 21,24,47 DATA >2124,>4750,>4C4C,>4E4B,>2100 F6BD 50,4C,4C F6C0 4E,4B,21 F6C3 00 <0350> *********************************************************** <0351> * <0352> * CATALOG HARD/DISK <0353> * <0354> F6C4 06,F6,C9 DIRECT CALL DMENU <0355> F6C7 57,56 BR DIREC2 <0356> F6C9 07,20 DMENU ALL SPACE Clear screen <0357> F6CB 08 FMT <0358> F6CC FF,09 COL 9 <0359> F6CE FE,01 ROW 1 <0360> F6D0 0E,2A,20 HTEX '* DIRECTORY * ' F6D3 44,49,52 F6D6 45,43,54 F6D9 4F,52,59 F6DC 20,2A,20 F6DF 20 <0361> F6E0 A3 ROW+ 4 <0362> F6E1 89 COL+ 10 <0363> F6E2 0B,44,65 HTEX 'Device Name?' F6E5 76,69,63 F6E8 65,20,4E F6EB 61,6D,65 F6EE 3F <0364> F6EF A7 ROW+ 8 <0365> F6F0 FF,03 COL 3 <0366> F6F2 17,41,43 HTEX 'ACTIVE KEYS: CLEAR, AID,' F6F5 54,49,56 F6F8 45,20,4B F6FB 45,59,53 F6FE 3A,20,43 F701 4C,45,41 F704 52,2C,20 F707 41,49,44 F70A 2C <0367> F70B A1 ROW+ 2 <0368> F70C FF,03 COL 3 <0369> F70E 14,28,41 HTEX '(ARROWS), E, e, X, x,' F711 52,52,4F F714 57,53,29 F717 2C,20,45 F71A 2C,20,65 F71D 2C,20,58 F720 2C,20,78 F723 2C <0370> F724 A1 ROW+ 2 99/4 GPL-ASSEMBLER (Pass 3) correct PAGE 0040 E/A GROM <0371> F725 FF,03 COL 3 <0372> F727 14,42,45 HTEX 'BEGIN, PROCEED, REDO,' F72A 47,49,4E F72D 2C,20,50 F730 52,4F,43 F733 45,45,44 F736 2C,20,52 F739 45,44,4F F73C 2C <0373> F73D A1 ROW+ 2 <0374> F73E FF,03 COL 3 <0375> F740 12,42,41 HTEX 'BACK, and SPACE BAR' F743 43,4B,2C F746 20,61,6E F749 64,20,53 F74C 50,41,43 F74F 45,20,42 F752 41,52 <0376> F754 FB FEND <0377> F755 00 RTN <0378> F756 86,74 DIREC2 CLR @KBNO Clear keyboard number <0379> F758 BF,20,01 DST >0102,@CURADD Prompt location F75B 02 <0380> F75C BF,1C,10 DST >1000,@PABPTR Use first PAB area F75F 00 <0381> F760 B6,48,20 OR >20,@FLAG Set return bit for error <0382> F763 06,E5,1D CALL GETALL Input the filename <0383> F766 86,42 DIREC3 CLR @XTOKEN <0384> F768 06,EF,65 CALL CLRREA <0385> F76B 31,00,09 MOVE 9,G@CATDAT,V*PABPTR Prepare PAB F76E B0,1C,FA F771 A1 <0386> F772 06,EF,73 CALL ONEKEY <0387> F775 06,E5,6A CALL DOIO Open the file <0388> F778 BF,B0,1C DST >020D,V*PABPTR Read opcode to PAB F77B 02,0D <0389> F77D 06,E5,6A CALL DOIO Read first record <0390> F780 07,20 ALL SPACE Clear screen again <0391> F782 06,FA,B2 CALL SCREEN Set up header <0392> F785 BE,AF,25 ST >20,V@>2500 F788 00,20 <0393> F78A 35,11,00 MOVE >1100,V@>2500,V@>2501 F78D AF,25,01 F790 AF,25,00 <0394> F793 BF,40,25 DST >2580,@>8340 F796 80 <0395> F797 BE,02,59 ST >59,@>8302 Y <0396> F79A 03 TSTKEY SCAN Scan the keyboard <0397> F79B 57,B5 BR TSTKE5 Any key? <0398> F79D D6,75,20 CEQ SPACE,@KEY SPACE KEY? <0399> F7A0 77,B2 BS TSTKE4 Yes, wait. <0400> F7A2 D6,75,0F CEQ BACK,@KEY BACK key? <0401> F7A5 57,AE BR TSTKE3 No <0402> F7A7 86,42 TSTKE2 CLR @XTOKEN Yes, so restart <0403> F7A9 06,E5,66 CALL CLOSE Close disk <0404> F7AC 56,C4 BR DIRECT Start Catalog again <0405> F7AE 86,42 TSTKE3 CLR @XTOKEN Clear flag <0406> F7B0 57,BF BR ARROWS <0407> F7B2 03 TSTKE4 SCAN Wait for any key. <0408> F7B3 57,B2 BR TSTKE4 Loop <0409> F7B5 06,E5,6A TSTKE5 CALL DOIO Read file info <0410> F7B8 06,FB,9F CALL FILNAM Put it on screen <0411> F7BB 57,9A BR TSTKEY Loop till done <0412> F7BD 92,1E DEC @COUNT COUNT-1 99/4 GPL-ASSEMBLER (Pass 3) correct PAGE 0041 E/A GROM <0413> F7BF 06,EE,34 ARROWS CALL CLRFAC <0414> F7C2 BC,4B,1E ST @COUNT,@FAC1 <0415> F7C5 CB,4A,00 DCHE 100,@FAC F7C8 64 <0416> F7C9 57,D3 BR ARROW1 <0417> F7CB A7,4A,00 DSUB 100,@FAC F7CE 64 <0418> F7CF BE,A0,1C ST 49,V@28 Show it 1__ F7D2 31 <0419> F7D3 CB,4A,00 ARROW1 DCHE 9,@FAC F7D6 09 <0420> F7D7 57,EC BR ARROW2 <0421> F7D9 AE,4A,0A DIV 10,@FAC <0422> F7DC A2,4A,30 ADD >30,@FAC <0423> F7DF BC,A0,1D ST @FAC,V@29 Show it _#_ F7E2 4A <0424> F7E3 A2,4B,30 ADD >30,@FAC1 <0425> F7E6 BC,A0,1E ST @FAC1,V@30 Show it __# F7E9 4B <0426> F7EA 57,F3 BR ARROW3 <0427> F7EC A2,4B,30 ARROW2 ADD >30,@FAC1 <0428> F7EF BC,A0,1E ST @FAC1,V@30 F7F2 4B <0429> F7F3 BF,10,00 ARROW3 DST >0081,@>8310 Arrows location F7F6 81 <0430> F7F7 BF,04,25 DST >2580,@>8304 Recall buffer F7FA 80 <0431> F7FB 35,02,60 OKKEY MOVE >0260,V*>8304,V@>0080 Fill screen F7FE A0,80,B0 F801 04 <0432> F802 BE,B0,10 NOKEY ST 130,V*>8310 Left arrow F805 82 <0433> F806 BE,E0,0B ST 131,V@11(@>8310) Right arrow F809 10,83 <0434> F80B 03 SCAN <0435> F80C D6,75,01 CEQ AID,@KEY AID <0436> F80F 58,2A BR NAID <0437> F811 35,03,00 MOVE 768,V@0,V@>2000 Save screen F814 AF,20,00 F817 A0,00 <0438> F819 06,F6,C9 CALL DMENU <0439> F81C 03 YAID SCAN Any key? <0440> F81D 58,1C BR YAID No. <0441> F81F 35,03,00 MOVE 768,V@>2000,V@0 Restore screen F822 A0,00,AF F825 20,00 <0442> F827 03 WAID SCAN Any key? <0443> F828 58,27 BR WAID <0444> F82A D6,75,02 NAID CEQ CLEAR,@KEY CLEAR <0445> F82D 77,A7 BS TSTKE2 <0446> F82F D6,75,0C CEQ PROCD,@KEY PROCEED <0447> F832 79,08 BS ENTER0 <0448> F834 D6,75,06 CEQ REDO,@KEY REDO <0449> F837 77,A7 BS TSTKE2 <0450> F839 D6,75,0F BACK0 CEQ BACK,@KEY BACK <0451> F83C 58,75 BR BEGIN0 <0452> F83E D7,AF,10 DCEQ 'DS',V@>100A DS? DISK ONLY? F841 0A,44,53 <0453> F844 77,A7 BS TSTKE2 <0454> F846 06,F9,0E CALL CLRBUF Clear buffers and FAC <0455> F849 BD,4A,AF DST V@>1008,@FAC Get length F84C 10,08 <0456> F84E D7,4A,00 DCEQ 5,@FAC DSK#. or SCS#. or WDS#. F851 05 99/4 GPL-ASSEMBLER (Pass 3) correct PAGE 0042 E/A GROM <0457> F852 78,A3 BS BEGIN3 <0458> F854 CB,4A,00 DCHE 4,@FAC F857 04 <0459> F858 58,A3 BR BEGIN3 <0460> F85A 06,F9,0E CALL CLRBUF Clear buffers and FAC <0461> F85D BD,4A,AF DST V@>1008,@FAC Get length F860 10,08 <0462> F862 93,4A BACK1 DDEC @FAC Length -1 <0463> F864 D6,EF,10 CEQ >2E,V@>1009(@FAC) .? F867 09,4A,2E <0464> F86A 58,62 BR BACK1 No, keep searching <0465> F86C CB,4A,00 DCHE 5,@FAC DSK. or SCS. or WDS. or DSK#. F86F 05 <0466> F870 78,A3 BS BEGIN3 <0467> F872 BE,75,0E BACK3 ST BEGIN,@KEY <0468> F875 D6,75,0E BEGIN0 CEQ BEGIN,@KEY BEGIN <0469> F878 58,C2 BR FCTNUP <0470> F87A 06,EE,34 CALL CLRFAC Clear buffers and FAC <0471> F87D BD,4A,AF DST V@>1008,@FAC Get length F880 10,08 <0472> F882 D7,4A,00 DCEQ 5,@FAC DSK#. or SCS#. or WDS#. F885 05 <0473> F886 78,9A BS BEGIN2 <0474> F888 87,4A DCLR @FAC Clear FAC <0475> F88A 91,4A BEGIN1 DINC @FAC COUNT +1 <0476> F88C D6,EF,10 CEQ >2E,V@>1009(@FAC) .? F88F 09,4A,2E <0477> F892 58,8A BR BEGIN1 No, keep searching <0478> F894 D7,4A,00 DCEQ 4,@FAC DSK. Length? F897 04 <0479> F898 78,8A BS BEGIN1 Yes, look for Volume. <0480> F89A 91,4A BEGIN2 DINC @FAC LENGTH+1 <0481> F89C BF,EF,10 DST >0D0D,V@>1009(@FAC) F89F 09,4A,0D F8A2 0D <0482> F8A3 BD,AF,10 BEGIN3 DST @FAC,V@>1008 F8A6 08,4A <0483> F8A8 A3,4A,00 DADD 2,@FAC F8AB 02 <0484> F8AC 34,4A,AF MOVE @FAC,V@>1008,V@>2255 F8AF 22,55,AF F8B2 10,08 <0485> F8B4 34,4A,AF MOVE @FAC,V@>1008,V@>2400 F8B7 24,00,AF F8BA 10,08 <0486> F8BC BE,42,37 ST >37,@XTOKEN <0487> F8BF 05,E0,28 B OLDEA [0008] *********************************************************** [0009] COPY 'DSK5.MYXB7-D' <0001> <0002> <0003> F8C2 D6,75,0B FCTNUP CEQ 11,@KEY FCTN UP <0004> F8C5 79,FE BS UPKEY <0005> F8C7 D6,75,45 CEQ 'E',@KEY UP (E) <0006> F8CA 79,FE BS UPKEY <0007> F8CC D6,75,65 CEQ 'e',@KEY UP (e) <0008> F8CF 79,FE BS UPKEY <0009> F8D1 D6,75,0A CEQ 10,@KEY FCTN DOWN <0010> F8D4 7A,16 BS DKEY <0011> F8D6 D6,75,58 CEQ 'X',@KEY DOWN (X) <0012> F8D9 7A,16 BS DKEY <0013> F8DB D6,75,78 CEQ 'x',@KEY DOWN (x) <0014> F8DE 7A,16 BS DKEY <0015> F8E0 D6,75,08 CEQ 8,@KEY FCTN LEFT 99/4 GPL-ASSEMBLER (Pass 3) correct PAGE 0043 E/A GROM <0016> F8E3 7A,3A BS LKEY <0017> F8E5 D6,75,53 CEQ 83,@KEY LEFT (S) <0018> F8E8 7A,3A BS LKEY <0019> F8EA D6,75,73 CEQ 115,@KEY LEFT (s) <0020> F8ED 7A,3A BS LKEY <0021> F8EF D6,75,09 CEQ 9,@KEY FCTN RIGHT <0022> F8F2 7A,5F BS RKEY <0023> F8F4 D6,75,44 CEQ 68,@KEY RIGHT (D) <0024> F8F7 7A,5F BS RKEY <0025> F8F9 D6,75,64 CEQ 100,@KEY RIGHT (d) <0026> F8FC 7A,5F BS RKEY <0027> F8FE D6,75,20 CEQ ' ',@KEY SPACE BAR <0028> F901 79,08 BS ENTER0 <0029> F903 D6,75,0D CEQ ENTER,@KEY ENTER <0030> F906 58,02 BR NOKEY <0031> F908 06,F9,0E ENTER0 CALL CLRBUF <0032> F90B 05,F9,29 B ENTR <0033> F90E BE,AF,22 CLRBUF ST ENTER,V@>2257 Clear buffer F911 57,0D <0034> F913 35,00,3F MOVE 63,V@>2257,V@>2258 F916 AF,22,58 F919 AF,22,57 <0035> F91C 35,00,3F MOVE 63,V@>2257,V@>2402 F91F AF,24,02 F922 AF,22,57 <0036> F925 06,EE,34 CALL CLRFAC <0037> F928 00 RTN <0038> F929 BD,06,AF ENTR DST V@>1008,@>8306 Get length of device F92C 10,08 <0039> F92E BE,EF,10 ST >2E,V@>1009(@>8306) F931 09,06,2E <0040> F934 34,06,AF MOVE @>8306,V@>100A,V@>2402 F937 24,02,AF F93A 10,0A <0041> F93C BD,4C,10 DST @>8310,@FAC2 <0042> F93F 90,11 INC @>8311 <0043> F941 90,4D ENTER1 INC @FAC3 Index+1 <0044> F943 90,4B INC @FAC1 Count+1 <0045> F945 D6,B0,4C CEQ SPACE,V*FAC2 Space? F948 20 <0046> F949 79,50 BS ENTER2 Yes <0047> F94B D6,4B,0B CEQ 11,@FAC1 To long? <0048> F94E 59,41 BR ENTER1 <0049> F950 BE,B0,4C ENTER2 ST ENTER,V*FAC2 cr F953 0D <0050> F954 D7,E0,10 DCEQ 'Di',V@16(@>8310) Directory? F957 10,44,69 <0051> F95A 59,6A BR NODIR No <0052> F95C D6,E0,12 CEQ 'r',V@18(@>8310) F95F 10,72 <0053> F961 59,6A BR NODIR <0054> F963 BF,B0,4C DST >2E0D,V*FAC2 .cr F966 2E,0D <0055> F968 90,4A INC @FAC Count+1 <0056> F96A 34,4A,EF NODIR MOVE @FAC,V*>8310,V@>100A(@>8306) F96D 10,0A,06 F970 B0,10 <0057> F972 A1,4A,06 DADD @>8306,@FAC <0058> F975 34,4A,AF MOVE @FAC,V@>100A,V@>2257 F978 22,57,AF F97B 10,0A <0059> F97D BD,AF,22 DST @FAC,V@>2255 F980 55,4A <0060> F982 90,07 INC @>8307 99/4 GPL-ASSEMBLER (Pass 3) correct PAGE 0044 E/A GROM <0061> F984 BD,AF,24 DST @>8306,V@>2400 F987 00,06 <0062> F989 06,E5,66 CALL CLOSE <0063> <0064> F98C BE,42,EA ST >EA,@XTOKEN Set flag <0065> <0066> F98F D6,75,20 CEQ 32,@KEY SPACE BAR <0067> F992 79,D8 BS XBPGM <0068> F994 D7,E0,10 DCEQ 'Di',V@16(@>8310) Directory? F997 10,44,69 <0069> F99A 59,A3 BR PORVI <0070> F99C D6,E0,12 CEQ 'r',V@18(@>8310) F99F 10,72 <0071> F9A1 76,C4 BS DIRECT <0072> F9A3 D6,E0,10 PORVI CEQ 'P',V@16(@>8310) Program? F9A6 10,50 <0073> F9A8 67,16 BS PRGRM <0074> F9AA D6,E0,14 CEQ 'V',V@20(@>8310) Variable? F9AD 10,56 <0075> F9AF 59,C7 BR DORF80 <0076> F9B1 D6,E0,10 CEQ 'I',V@16(@>8310) Internal? F9B4 10,49 <0077> F9B6 59,C7 BR DORF80 <0078> F9B8 D7,E0,18 DCEQ '25',V@24(@>8310) Length 25_? F9BB 10,32,35 <0079> F9BE 59,C7 BR DORF80 <0080> F9C0 D6,E0,1A CEQ '4',V@26(@>8310) Length 254? F9C3 10,34 <0081> F9C5 6E,D9 BS XBINP <0082> F9C7 D7,E0,19 DORF80 DCEQ '80',V@25(@>8310) Length 80? F9CA 10,38,30 <0083> F9CD 40,71 BR MMENU <0084> F9CF D6,E0,14 CEQ 'F',V@20(@>8310) Fixed? F9D2 10,46 <0085> F9D4 69,E4 BS LANDR <0086> F9D6 40,71 BR MMENU <0087> F9D8 D6,E0,10 XBPGM CEQ 'P',V@16(@>8310) Program? F9DB 10,50 <0088> F9DD 6E,D9 BS XBINP <0089> F9DF D6,E0,14 CEQ 'V',V@20(@>8310) Variable? F9E2 10,56 <0090> F9E4 40,71 BR MMENU <0091> F9E6 D6,E0,10 CEQ 'I',V@16(@>8310) Internal? F9E9 10,49 <0092> F9EB 40,71 BR MMENU <0093> F9ED D7,E0,18 DCEQ '25',V@24(@>8310) Length 25_? F9F0 10,32,35 <0094> F9F3 40,71 BR MMENU <0095> F9F5 D6,E0,1A CEQ '4',V@26(@>8310) Length 254? F9F8 10,34 <0096> F9FA 6E,D9 BS XBINP <0097> F9FC 40,71 BR MMENU <0098> <0099> F9FE D7,10,00 UPKEY DCEQ >0081,@>8310 Top of screen? FA01 81 <0100> FA02 7A,0A BS GLESS So scroll screen down <0101> FA04 A7,10,00 DSUB 32,@>8310 Up one. FA07 20 <0102> FA08 5A,14 BR GLESS2 Return <0103> FA0A D7,04,25 GLESS DCEQ >2580,@>8304 Start of buffer? FA0D 80 <0104> FA0E 77,FB BS OKKEY Yes <0105> FA10 A7,04,00 DSUB >20,@>8304 One more line down FA13 20 99/4 GPL-ASSEMBLER (Pass 3) correct PAGE 0045 E/A GROM <0106> FA14 57,FB GLESS2 BR OKKEY <0107> FA16 D6,E0,01 DKEY CEQ >20,V@1(@>8310) Blank line? FA19 10,20 <0108> FA1B 79,FE BS UPKEY <0109> FA1D D7,10,02 DCEQ >02C1,@>8310 Bottom of screen? FA20 C1 <0110> FA21 7A,29 BS GMORE So scroll screen up <0111> FA23 A3,10,00 DADD 32,@>8310 Down one. FA26 20 <0112> FA27 57,FB BR OKKEY No <0113> FA29 D5,04,40 GMORE DCEQ @>8340,@>8304 End of buffer? <0114> FA2C 77,FB BS OKKEY Yes <0115> FA2E D6,A0,A2 CEQ >20,V@>00A2 Last line in buffer? FA31 20 <0116> FA32 77,FB BS OKKEY Yes <0117> FA34 A3,04,00 DADD >20,@>8304 One more line up FA37 20 <0118> FA38 57,FB BR OKKEY <0119> FA3A BE,76,12 LKEY ST 18,@>8376 Line Counter <0120> FA3D D7,10,00 LUPKEY DCEQ >0081,@>8310 Top of screen? FA40 81 <0121> FA41 7A,49 BS LGLESS So scroll screen down <0122> FA43 A7,10,00 DSUB 32,@>8310 Up one. FA46 20 <0123> FA47 5A,53 BR LGLES2 Return <0124> FA49 D7,04,25 LGLESS DCEQ >2580,@>8304 Start of buffer? FA4C 80 <0125> FA4D 7A,55 BS LOKKEY Yes <0126> FA4F A7,04,00 DSUB >20,@>8304 One more line down FA52 20 <0127> FA53 5A,55 LGLES2 BR LOKKEY <0128> FA55 06,FA,90 LOKKEY CALL FLSCR <0129> FA58 92,76 DEC @>8376 Line counter -1 <0130> FA5A 5A,3D BR LUPKEY Continue Loop <0131> FA5C 05,F8,02 B NOKEY Done. <0132> FA5F BE,76,12 RKEY ST 18,@>8376 Line Counter <0133> FA62 D6,E0,01 RDKEY CEQ >20,V@1(@>8310) Blank line? FA65 10,20 <0134> FA67 79,FE BS UPKEY <0135> FA69 D7,10,02 DCEQ >02C1,@>8310 Bottom of screen? FA6C C1 <0136> FA6D 7A,75 BS RGMORE So scroll screen up <0137> FA6F A3,10,00 DADD 32,@>8310 Down one. FA72 20 <0138> FA73 5A,86 BR ROKKEY No <0139> FA75 D5,04,40 RGMORE DCEQ @>8340,@>8304 End of buffer? <0140> FA78 7A,86 BS ROKKEY Yes <0141> FA7A D6,A0,A2 CEQ >20,V@>00A2 Last line in buffer? FA7D 20 <0142> FA7E 7A,86 BS ROKKEY Yes <0143> FA80 A3,04,00 DADD >20,@>8304 One more line up FA83 20 <0144> FA84 5A,86 BR ROKKEY <0145> FA86 06,FA,90 ROKKEY CALL FLSCR <0146> FA89 92,76 DEC @>8376 Line counter -1 <0147> FA8B 5A,62 BR RDKEY Continue Loop <0148> FA8D 05,F8,02 B NOKEY Done. <0149> FA90 35,02,60 FLSCR MOVE >0260,V*>8304,V@>0080 Fill screen FA93 A0,80,B0 FA96 04 <0150> FA97 BE,B0,10 ST 130,V*>8310 Left arrow FA9A 82 <0151> FA9B BE,E0,0B ST 131,V@11(@>8310) Right arrow FA9E 10,83 99/4 GPL-ASSEMBLER (Pass 3) correct PAGE 0046 E/A GROM <0152> FAA0 00 RTN <0153> * <0154> * PAB data <0155> * <0156> FAA1 00,0D,08 CATDAT BYTE 0,>D,8,>36,0,0,0,0,0 FAA4 36,00,00 FAA7 00,00,00 <0157> * <0158> FAAA 40,02,00 HALVE BYTE >40,>02,0,0,0,0,0,0 FAAD 00,00,00 FAB0 00,00 <0159> * <0160> * Screen - prints initial screen and disk info <0161> * <0162> FAB2 08 SCREEN FMT <0163> FAB3 FE,00 ROW 0 <0164> FAB5 FF,02 COL 2 <0165> FAB7 1C,44,69 HTEX 'Directory= Files000' FABA 72,65,63 FABD 74,6F,72 FAC0 79,3D,20 FAC3 20,20,20 FAC6 20,20,20 FAC9 20,20,20 FACC 20,46,69 FACF 6C,65,73 FAD2 30,30,30 <0166> FAD5 A0 ROW+ 1 <0167> FAD6 FF,02 COL 2 <0168> FAD8 14,46,72 HTEX 'Free= Used=' FADB 65,65,3D FADE 20,20,20 FAE1 20,20,20 FAE4 20,20,20 FAE7 20,20,55 FAEA 73,65,64 FAED 3D <0169> FAEE A0 ROW+ 1 <0170> FAEF FF,02 COL 2 <0171> FAF1 1C,20,46 HTEX ' Filename Size Type P' FAF4 69,6C,65 FAF7 6E,61,6D FAFA 65,20,20 FAFD 53,69,7A FB00 65,20,20 FB03 20,20,54 FB06 79,70,65 FB09 20,20,20 FB0C 20,20,50 <0172> FB0F A0 ROW+ 1 <0173> FB10 FF,02 COL 2 <0174> FB12 1C,2D,2D HTEX '---------- ---- ----------- -' FB15 2D,2D,2D FB18 2D,2D,2D FB1B 2D,2D,20 FB1E 2D,2D,2D FB21 2D,20,2D FB24 2D,2D,2D FB27 2D,2D,2D FB2A 2D,2D,2D FB2D 2D,20,2D <0175> FB30 FB FEND <0176> FB31 86,1E CLR @COUNT Clear file counter <0177> FB33 06,FC,9D CALL DISSTR Get string into FAC 99/4 GPL-ASSEMBLER (Pass 3) correct PAGE 0047 E/A GROM <0178> FB36 8E,4B CZ @FAC1 Skip if zero length <0179> FB38 7B,42 BS CAT3 <0180> FB3A 08 FMT <0181> FB3B FE,00 ROW 0 <0182> FB3D FF,0C COL 12 <0183> FB3F E9,4C HSTR 10,@FAC2 <0184> FB41 FB FEND <0185> FB42 A1,10,4A CAT3 DADD @FAC,@>8310 Go to next field <0186> FB45 A3,10,00 DADD 19,@>8310 Continue to last field FB48 13 <0187> FB49 BF,14,00 DST >28,@>8314 Set up screen addr FB4C 28 <0188> FB4D D7,AF,10 DCEQ >4453,V@>100A DSK? FB50 0A,44,53 <0189> FB53 5B,5B BR CAT4 No, must be HARD <0190> FB55 06,FC,7A CALL DISNUM Display available DSK space <0191> FB58 05,FB,6E B CAT4A <0192> FB5B 35,00,08 CAT4 MOVE 8,V*>8310,@ARG Get Available space *2 FB5E 5C,B0,10 <0193> FB61 31,00,08 MOVE 8,G@HALVE,@FAC Get divisor FB64 4A,FA,AA <0194> FB67 0F,09 XML FDIV <0195> FB69 0F,02 XML ROUND <0196> FB6B 06,FC,80 CALL DISNU1 Display available HARD space <0197> * Display used space <0198> FB6E 35,00,08 CAT4A MOVE 8,V*>8310,@FAC Get Available space FB71 4A,B0,10 <0199> FB74 A7,10,00 DSUB 9,@>8310 Point to formatted space FB77 09 <0200> FB78 35,00,08 MOVE 8,V*>8310,@ARG Move it to ARG FB7B 5C,B0,10 <0201> FB7E 0F,07 XML FSUB Develop used value *2 <0202> FB80 BF,14,00 DST >38,@>8314 Set up screen addr FB83 38 <0203> FB84 D7,AF,10 DCEQ >4453,V@>100A DSK? FB87 0A,44,53 <0204> FB8A 7B,9B BS CAT4B Yes, must be DISK <0205> FB8C 35,00,08 MOVE 8,@FAC,@ARG Get Unused space *2 FB8F 5C,4A <0206> FB91 31,00,08 MOVE 8,G@HALVE,@FAC Get divisor FB94 4A,FA,AA <0207> FB97 0F,09 XML FDIV <0208> FB99 0F,02 XML ROUND <0209> FB9B 06,FC,80 CAT4B CALL DISNU1 Display used space <0210> FB9E 00 RTN Return <0211> * <0212> * Display one file on screen <0213> * <0214> FB9F 06,FC,9D FILNAM CALL DISSTR Get string into FAC <0215> FBA2 90,1E INC @COUNT FILE COUNT +1 <0216> FBA4 8E,4B CZ @FAC1 Skip display if zero <0217> FBA6 7B,B0 BS CAT5 length <0218> FBA8 08 FMT Put disk name on screen <0219> FBA9 FE,17 ROW 23 . <0220> FBAB FF,02 COL 02 . <0221> FBAD E9,4C HSTR 10,@FAC2 . <0222> FBAF FB FEND . <0223> FBB0 A1,10,4A CAT5 DADD @FAC,@>8310 Go to next field <0224> FBB3 A3,10,00 DADD 10,@>8310 Continue another field FBB6 0A <0225> FBB7 8F,B0,10 DCZ V*>8310 Time to get out if <0226> FBBA 7C,75 BS FILNA1 zero file size <0227> FBBC BF,14,02 DST >2EA,@>8314 Set up screen address FBBF EA 99/4 GPL-ASSEMBLER (Pass 3) correct PAGE 0048 E/A GROM <0228> FBC0 06,FC,7A CALL DISNUM Display file length <0229> FBC3 A7,10,00 DSUB 9,@>8310 Back a field FBC6 09 <0230> FBC7 35,00,08 MOVE 8,V*>8310,@FAC Move it into FAC FBCA 4A,B0,10 <0231> FBCD 0F,12 XML CFI Convert it to an int. <0232> FBCF 8E,4A CZ @FAC Non-negative? <0233> FBD1 7B,D9 BS CAT5A YES! File not protected <0234> FBD3 BC,A2,FE ST @>8302,V@>2FE Put a 'Y' on screen FBD6 02 <0235> FBD7 83,4A DNEG @FAC Make number positive <0236> FBD9 92,4B CAT5A DEC @FAC1 Adjust for CASE <0237> FBDB 8A,4B CASE @FAC1 Show file type <0238> FBDD 5B,E9 BR DF . <0239> FBDF 5B,F9 BR DV . <0240> FBE1 5C,09 BR IF . <0241> FBE3 5C,19 BR IV . <0242> FBE5 5C,29 BR PR . <0243> FBE7 5C,39 BR DI <0244> FBE9 08 DF FMT <0245> FBEA FE,17 ROW 23 <0246> FBEC FF,12 COL 18 <0247> FBEE 06,44,69 HTEX 'Dis/Fix' FBF1 73,2F,46 FBF4 69,78 <0248> FBF6 FB FEND <0249> FBF7 5C,4B BR CAT6 <0250> FBF9 08 DV FMT <0251> FBFA FE,17 ROW 23 <0252> FBFC FF,12 COL 18 <0253> FBFE 06,44,69 HTEX 'Dis/Var' FC01 73,2F,56 FC04 61,72 <0254> FC06 FB FEND <0255> FC07 5C,4B BR CAT6 <0256> FC09 08 IF FMT <0257> FC0A FE,17 ROW 23 <0258> FC0C FF,12 COL 18 <0259> FC0E 06,49,6E HTEX 'Int/Fix' FC11 74,2F,46 FC14 69,78 <0260> FC16 FB FEND <0261> FC17 5C,4B BR CAT6 <0262> FC19 08 IV FMT <0263> FC1A FE,17 ROW 23 <0264> FC1C FF,12 COL 18 <0265> FC1E 06,49,6E HTEX 'Int/Var' FC21 74,2F,56 FC24 61,72 <0266> FC26 FB FEND <0267> FC27 5C,4B BR CAT6 <0268> FC29 08 PR FMT <0269> FC2A FE,17 ROW 23 <0270> FC2C FF,12 COL 18 <0271> FC2E 06,50,72 HTEX 'Program' FC31 6F,67,72 FC34 61,6D <0272> FC36 FB FEND <0273> FC37 5C,56 BR CAT7 Return <0274> FC39 08 DI FMT <0275> FC3A FE,17 ROW 23 <0276> FC3C FF,12 COL 18 <0277> FC3E 08,44,69 HTEX 'Directory' FC41 72,65,63 99/4 GPL-ASSEMBLER (Pass 3) correct PAGE 0049 E/A GROM FC44 74,6F,72 FC47 79 <0278> FC48 FB FEND <0279> FC49 5C,56 BR CAT7 <0280> FC4B A3,10,00 CAT6 DADD 18,@>8310 Advavce two fields FC4E 12 <0281> FC4F BF,14,02 DST >2F6,@>8314 Set up screen address FC52 F6 <0282> FC53 06,FC,7A CALL DISNUM Display record length <0283> FC56 35,00,1F CAT7 MOVE >1F,V@>02E0,V@0(@>8340) FC59 E0,00,40 FC5C A2,E0 <0284> FC5E A3,40,00 DADD >20,@>8340 FC61 20 <0285> * <0286> * Scroll the screen <0287> * <0288> FC62 35,02,60 SCROLL MOVE >260,V@>A0,V@>80 Scroll screen FC65 A0,80,A0 FC68 A0 <0289> FC69 BE,A2,E0 ST SPACE,V@>2E0 Clear last line FC6C 20 <0290> FC6D 35,00,1F MOVE >1F,V@>2E0,V@>2E1 FC70 A2,E1,A2 FC73 E0 <0291> FC74 00 RTN Return <0292> FC75 87,12 FILNA1 DCLR @>8312 Clear a byte <0293> FC77 8E,12 CZ @>8312 Set COND bit <0294> FC79 01 RTNC Return w/COND <0295> * Display number subroutine <0296> * ENTER: Floating number in FAC for DISNU1 <0297> * Screen address in >8314 <0298> * <0299> FC7A 35,00,08 DISNUM MOVE 8,V*>8310,@FAC Move FLP number to FAC FC7D 4A,B0,10 <0300> FC80 86,55 DISNU1 CLR @FAC11 Indicate a free format <0301> FC82 06,00,14 CALL CNS Convert FAC to a string <0302> FC85 BF,16,00 DST 7,@>8316 Right justify number FC88 07 <0303> FC89 A4,17,56 S @FAC12,@>8317 <0304> FC8C A1,14,16 DADD @>8316,@>8314 <0305> FC8F BC,B0,14 DISNU2 ST *FAC11,V*>8314 Put a char on the screen FC92 90,55 <0306> FC94 91,14 DINC @>8314 Increment screen addr. <0307> FC96 90,55 INC @FAC11 Increment FAC addr. <0308> FC98 92,56 DEC @FAC12 Decrement string length count <0309> FC9A 5C,8F BR DISNU2 Loop until done <0310> FC9C 00 RTN Return to caller <0311> * <0312> * Prepare a VDP string for FORMAT statement <0313> * LEAVE: FAC has string length (word) <0314> * FAC2 has string <0315> * >8310 pointing to next string in record <0316> * <0317> FC9D BF,10,08 DISSTR DST >0836,@>8310 Get buffer address FCA0 36 <0318> FCA1 86,4A CLR @FAC Clear MSB of FAC word <0319> FCA3 BC,4B,B0 ST V*>8310,@FAC1 Store disk name length FCA6 10 <0320> FCA7 91,10 DINC @>8310 Point to string <0321> FCA9 BE,4C,20 ST >20,@FAC2 Clear out string space <0322> FCAC 35,00,09 MOVE 9,@FAC2,@FAC3 . FCAF 4D,4C <0323> FCB1 34,4A,4C MOVE @FAC,V*>8310,@FAC2 Move disk name into FAC 99/4 GPL-ASSEMBLER (Pass 3) correct PAGE 0050 E/A GROM FCB4 B0,10 <0324> FCB6 00 RTN <0325> *********************************************************** <0326> FCB7 FD,33 VEIW40 DATA EADSR * Viewer 40 Column <0327> FCB9 FC,BF DATA MV40 <0328> FCBB 03,56,34 STRI 'V40' FCBE 30 <0329> ******************************* <0330> FCBF BD,58,56 MV40 DST @>8356,@>8358 <0331> FCC2 A5,58,54 DSUB @>8354,@>8358 <0332> FCC5 35,00,0A MOVE 10,V@-10(@>8358),@FAC FCC8 4A,EF,FF FCCB F6,58 <0333> FCCD B2,EF,FF AND >1F,V@-9(@>8358) FCD0 F7,58,1F <0334> FCD3 C6,4A,04 CH >04,@FAC <0335> FCD6 7D,16 BS DSREXT <0336> FCD8 8A,4A CASE @FAC <0337> FCDA 5C,F6 BR VOPEN * OPEN <0338> FCDC 5D,19 BR VCLOSE * CLOSE <0339> FCDE 5D,16 BR DSREXT * READ <0340> FCE0 35,03,70 MOVE 880,V@80,V@0 * WRITE FCE3 A0,00,A0 FCE6 50 <0341> FCE7 35,00,50 MOVE 80,V*FAC2,V@880 FCEA A3,70,B0 FCED 4C <0342> FCEE 03 SCAN <0343> FCEF 5D,16 BR DSREXT <0344> FCF1 03 FREEZE SCAN <0345> FCF2 5C,F1 BR FREEZE <0346> FCF4 5D,16 BR DSREXT <0347> FCF6 35,00,80 VOPEN MOVE 128,V@>0380,V@-128(@>8370) FCF9 EF,FF,80 FCFC 70,A3,80 <0348> FCFF BE,4A,F0 ST >F0,@FAC <0349> FD02 3D,00,01 MOVE 1,@FAC,#1 FD05 01,4A <0350> FD07 BE,80,D4 ST >F0,@>83D4 FD0A F0 <0351> FD0B BE,A0,00 ST >20,V@0 FD0E 20 <0352> FD0F 35,03,BF MOVE 959,V@0,V@1 FD12 A0,01,A0 FD15 00 <0353> FD16 06,00,12 DSREXT CALL RETURN <0354> FD19 03 VCLOSE SCAN <0355> FD1A 5D,19 BR VCLOSE <0356> FD1C 35,00,80 MOVE 128,V@-128(@>8370),V@>0380 FD1F A3,80,EF FD22 FF,80,70 <0357> FD25 BE,00,E0 ST >E0,@>8300 <0358> FD28 3D,00,01 MOVE 1,@>8300,#1 FD2B 01,00 <0359> FD2D BE,80,D4 ST >E0,@>83D4 FD30 E0 <0360> FD31 5D,16 BR DSREXT <0361> ************************************ <0362> FD33 FD,3A EADSR DATA SEADSR <0363> FD35 E0,28 DATA OLDEA <0364> FD37 02,45,41 STRI 'EA' <0365> FD3A FD,41 SEADSR DATA XBDSR <0366> FD3C E0,28 DATA OLDEA <0367> FD3E 02,65,61 STRI 'ea' 99/4 GPL-ASSEMBLER (Pass 3) correct PAGE 0051 E/A GROM <0368> ************************************ <0369> FD41 FD,48 XBDSR DATA SXBDSR <0370> FD43 63,72 DATA RXB <0371> FD45 02,58,42 STRI 'XB' <0372> FD48 FD,4F SXBDSR DATA BASIC <0373> FD4A 63,72 DATA RXB <0374> FD4C 02,78,62 STRI 'xb' <0375> ************************************ <0376> FD4F FD,59 BASIC DATA SBASIC <0377> FD51 21,6F DATA >216F <0378> FD53 05,42,41 STRI 'BASIC' FD56 53,49,43 <0379> FD59 00,00 SBASIC DATA >0000 <0380> FD5B 21,6F DATA >216F <0381> FD5D 05,62,61 STRI 'basic' FD60 73,69,63 <0382> ************************************ <0383> END 99/4 GPL-ASSEMBLER (Pass 3) correct PAGE 0052 E/A GROM Symbol Table #1 (New,alpha) 0001 AID 835C ARG F7D3 ARROW1 F7EC ARROW2 F7F3 ARROW3 F7BF ARROWS E82D ASSEM 000F BACK F839 BACK0 F862 BACK1 F872 BACK3 FD4F BASIC 000E BEGIN F875 BEGIN0 F88A BEGIN1 F89A BEGIN2 F8A3 BEGIN3 001C BERR 0038 BGETSS EDE2 BINIT2 EDEA BINIT3 E520 BLDPAB E551 BLNKBU EE22 BUGS FB42 CAT3 FB5B CAT4 FB6E CAT4A FB9B CAT4B FBB0 CAT5 FBD9 CAT5A FC4B CAT6 FC56 CAT7 FAA1 CATDAT ED53 CCRMSG EBEF CHKER2 EBE4 CHKERR 8318 CHRCUR 0023 CIF 0002 CLEAR E566 CLOSE F90E CLRBUF E032 CLREA EE34 CLRFAC ECD4 CLRMSG EF65 CLRREA E708 CLRXOP EC30 CLSALL EC4D CLSPAB 8322 CODE E22D COLBAC E23A COLEND 077F COLOR E1B7 COLORS E210 COLSCN 831E COUNT 8320 CURADD EDC4 CUREDP EDCC CURPAT E17F DARROW EE12 DASSM1 E823 DDSK1 E828 DEDIT1 EE64 DEV1 EE7D DEV2 EE80 DEV3 EE81 DEV4 EE3C DEVICE EE7A DEVNO FBE9 DF FC39 DI F756 DIREC2 F766 DIREC3 F6C4 DIRECT FC80 DISNU1 FC8F DISNU2 FC7A DISNUM FC9D DISSTR FA16 DKEY E821 DLEN EE1D DLOAD F6C9 DMENU E56A DOIO F9C7 DORF80 FD16 DSREXT 0010 DSRLNK 0012 DSRRET EE17 DUTIL1 FBF9 DV FD33 EADSR E6E1 EASCRN E246 EDITOR E3CF EMOPT2 8326 ENDLN 000D ENTER F908 ENTER0 F941 ENTER1 F950 ENTER2 F929 ENTR 8354 ERCODE ED48 ERRC ED79 ERRCE ED88 ERRDD ED17 ERRIOC ED6D ERRIT ED0B ERRMF EC6D ERRMSG ED26 ERRNME ED3A ERRNTL ECE0 ERROR EDB2 ERRPNF ED9D ERRUR E6BA EXPMEM 834A FAC 834B FAC1 8355 FAC11 8356 FAC12 834C FAC2 834D FAC3 834E FAC4 834F FAC5 8350 FAC6 8351 FAC7 8352 FAC8 8353 FAC9 F8C2 FCTNUP FC75 FILNA1 FB9F FILNAM 8348 FLAG 8349 FLAG2 FA90 FLSCR EAED FNDDON EA8A FNDLNK EA90 FNDLP EAAD FNDSHO FCF1 FREEZE 0000 G0000 0001 G0001 E03B GE029 E047 GE056 E07C GE116 E199 GE11F E2B5 GE19B E2FD GE1E2 E2FF GE1E4 E338 GE1F6 E354 GE1FC E385 GE22C E390 GE237 E39B GE23B E3C5 GE25B E3DB GE271 E3DC GE272 E3E5 GE27B E3ED GE283 E418 GE29C E42F GE2B3 E431 GE2B5 E440 GE2C4 E455 GE2D9 E487 GE30A E49F GE322 E4A8 GE32B E4C1 GE344 E4DC GE35F E4DE GE361 E4E4 GE367 E4FD GE380 E50A GE38D E550 GE3CF E596 GE415 E5AC GE42B E5AF GE42E E5BD GE43C E5C7 GE446 E5CD GE44C E5F6 GE456 E600 GE460 E621 GE46B E626 GE470 E632 GE47C E63B GE485 E64F GE499 E661 GE4AB E689 GE4D3 E693 GE4DD E6B7 GE501 E6B9 GE503 E793 GE597 E7A2 GE5A6 E7EA GE5E5 E80A GE605 E875 GE654 E880 GE687 E953 GE736 E973 GE756 E984 GE767 E9A1 GE784 E9BA GE7A2 E9BF GE7A7 E9CC GE7B1 E9DB GE7C0 EA15 GE7F2 EA3B GE816 EA46 GE821 EA4B GE826 EA5B GE848 EB11 GE883 EB1C GE88E EB31 GE8A3 EB34 GE8A8 EB3C GE8B0 EB3F GE8B3 EB60 GE8D4 EB6F GE8E3 EB81 GE8F5 EB88 GE8FC EB8E GE907 EB8F GE908 EB96 GE90F EB9D GE916 EBA4 GE91D EBAF GE928 EBB6 GE92F EBBD GE936 EBC4 GE93D EBCB GE944 EBD0 GE949 EBDF GE958 EC0D GE97A EC1C GE97F EC77 GE9DA EBA9 GE9E2 EC95 GE9F8 ECAF GEA12 ECBC GEA1F ECCB GEA2E EDF4 GEBA0 EE11 GEBBD E51D GETALL E58B GETINP E5BE GETKEY EF94 GF000 FA0A GLESS FA14 GLESS2 FA29 GMORE FAAA HALVE FC09 IF 8379 ITIMER FC19 IV 8374 KBNO 8375 KEY E9E4 LANDR 8347 LDFLAG FA53 LGLES2 FA49 LGLESS FA3A LKEY E7AE LODPGM E7BB LODUSR FA55 LOKKEY FA3D LUPKEY E010 MENU E071 MMENU EADC MORSCN E086 MSCRN FCBF MV40 E18F MYEAXB E78C MYSRCH F82A NAID E6DB NESCRN E037 NEWEA E16F NEWSCN E785 NO1KEY F96A NODIR E744 NOEABF F802 NOKEY F7FB OKKEY E028 OLDEA EF73 ONEKEY EACA OUTSCN E819 PAB E544 PABNAM 831C PABPTR E7D9 PGMLOD E9A8 PLEASE E7D1 PMSG F9A3 PORVI FC29 PR ECE9 PRESS E716 PRGRM 000C PROCD E5DA PSCANX FA62 RDKEY 0006 REDO FA75 RGMORE FA5F RKEY FA86 ROKKEY 0002 ROUND E17C RTRXB EA59 RUN 6372 RXB FD59 SBASIC FAB2 SCREEN FC62 SCROLL FD3A SEADSR E025 SOLDEA 0020 SPACE 8324 STLN 8373 SUBSTK FD48 SXBDSR F7A7 TSTKE2 F7AE TSTKE3 F7B2 TSTKE4 F7B5 TSTKE5 F79A TSTKEY EF93 TWOKEY 99/4 GPL-ASSEMBLER (Pass 3) correct PAGE 0053 E/A GROM F9FE UPKEY E6FA USSCRN 837D VCHAR FD19 VCLOSE FCB7 VEIW40 E47D VFILE E413 VIEWR E406 VIT40 FCF6 VOPEN 8356 VPAB EDDC VREGS 836E VSTACK E57F VZERO F827 WAID ED00 WARN ECC4 WENTER EC61 WRNMSG EEDE XBAGN FD41 XBDSR EED9 XBINP EF11 XBINP1 EF49 XBINP2 EF5B XBINP3 F9D8 XBPGM 8342 XTOKEN F81C YAID E9B7 YESNO 99/4 GPL-ASSEMBLER (Pass 3) correct PAGE 0054 E/A GROM Symbol Table #2 (New,value) 0000 G0000 0001 AID 0001 G0001 0002 CLEAR 0002 ROUND 0006 REDO 000C PROCD 000D ENTER 000E BEGIN 000F BACK 0010 DSRLNK 0012 DSRRET 001C BERR 0020 SPACE 0023 CIF 0038 BGETSS 077F COLOR 6372 RXB 8318 CHRCUR 831C PABPTR 831E COUNT 8320 CURADD 8322 CODE 8324 STLN 8326 ENDLN 8342 XTOKEN 8347 LDFLAG 8348 FLAG 8349 FLAG2 834A FAC 834B FAC1 834C FAC2 834D FAC3 834E FAC4 834F FAC5 8350 FAC6 8351 FAC7 8352 FAC8 8353 FAC9 8354 ERCODE 8355 FAC11 8356 FAC12 8356 VPAB 835C ARG 836E VSTACK 8373 SUBSTK 8374 KBNO 8375 KEY 8379 ITIMER 837D VCHAR E010 MENU E025 SOLDEA E028 OLDEA E032 CLREA E037 NEWEA E03B GE029 E047 GE056 E071 MMENU E07C GE116 E086 MSCRN E16F NEWSCN E17C RTRXB E17F DARROW E18F MYEAXB E199 GE11F E1B7 COLORS E210 COLSCN E22D COLBAC E23A COLEND E246 EDITOR E2B5 GE19B E2FD GE1E2 E2FF GE1E4 E338 GE1F6 E354 GE1FC E385 GE22C E390 GE237 E39B GE23B E3C5 GE25B E3CF EMOPT2 E3DB GE271 E3DC GE272 E3E5 GE27B E3ED GE283 E406 VIT40 E413 VIEWR E418 GE29C E42F GE2B3 E431 GE2B5 E440 GE2C4 E455 GE2D9 E47D VFILE E487 GE30A E49F GE322 E4A8 GE32B E4C1 GE344 E4DC GE35F E4DE GE361 E4E4 GE367 E4FD GE380 E50A GE38D E51D GETALL E520 BLDPAB E544 PABNAM E550 GE3CF E551 BLNKBU E566 CLOSE E56A DOIO E57F VZERO E58B GETINP E596 GE415 E5AC GE42B E5AF GE42E E5BD GE43C E5BE GETKEY E5C7 GE446 E5CD GE44C E5DA PSCANX E5F6 GE456 E600 GE460 E621 GE46B E626 GE470 E632 GE47C E63B GE485 E64F GE499 E661 GE4AB E689 GE4D3 E693 GE4DD E6B7 GE501 E6B9 GE503 E6BA EXPMEM E6DB NESCRN E6E1 EASCRN E6FA USSCRN E708 CLRXOP E716 PRGRM E744 NOEABF E785 NO1KEY E78C MYSRCH E793 GE597 E7A2 GE5A6 E7AE LODPGM E7BB LODUSR E7D1 PMSG E7D9 PGMLOD E7EA GE5E5 E80A GE605 E819 PAB E821 DLEN E823 DDSK1 E828 DEDIT1 E82D ASSEM E875 GE654 E880 GE687 E953 GE736 E973 GE756 E984 GE767 E9A1 GE784 E9A8 PLEASE E9B7 YESNO E9BA GE7A2 E9BF GE7A7 E9CC GE7B1 E9DB GE7C0 E9E4 LANDR EA15 GE7F2 EA3B GE816 EA46 GE821 EA4B GE826 EA59 RUN EA5B GE848 EA8A FNDLNK EA90 FNDLP EAAD FNDSHO EACA OUTSCN EADC MORSCN EAED FNDDON EB11 GE883 EB1C GE88E EB31 GE8A3 EB34 GE8A8 EB3C GE8B0 EB3F GE8B3 EB60 GE8D4 EB6F GE8E3 EB81 GE8F5 EB88 GE8FC EB8E GE907 EB8F GE908 EB96 GE90F EB9D GE916 EBA4 GE91D EBA9 GE9E2 EBAF GE928 EBB6 GE92F EBBD GE936 EBC4 GE93D EBCB GE944 EBD0 GE949 EBDF GE958 EBE4 CHKERR EBEF CHKER2 EC0D GE97A EC1C GE97F EC30 CLSALL EC4D CLSPAB EC61 WRNMSG EC6D ERRMSG EC77 GE9DA EC95 GE9F8 ECAF GEA12 ECBC GEA1F ECC4 WENTER ECCB GEA2E ECD4 CLRMSG ECE0 ERROR ECE9 PRESS ED00 WARN ED0B ERRMF ED17 ERRIOC ED26 ERRNME ED3A ERRNTL ED48 ERRC ED53 CCRMSG ED6D ERRIT ED79 ERRCE ED88 ERRDD ED9D ERRUR EDB2 ERRPNF EDC4 CUREDP EDCC CURPAT EDDC VREGS EDE2 BINIT2 EDEA BINIT3 EDF4 GEBA0 EE11 GEBBD EE12 DASSM1 EE17 DUTIL1 EE1D DLOAD EE22 BUGS EE34 CLRFAC EE3C DEVICE EE64 DEV1 EE7A DEVNO EE7D DEV2 EE80 DEV3 EE81 DEV4 EED9 XBINP EEDE XBAGN EF11 XBINP1 EF49 XBINP2 EF5B XBINP3 EF65 CLRREA EF73 ONEKEY EF93 TWOKEY EF94 GF000 F6C4 DIRECT F6C9 DMENU F756 DIREC2 F766 DIREC3 F79A TSTKEY F7A7 TSTKE2 F7AE TSTKE3 F7B2 TSTKE4 F7B5 TSTKE5 F7BF ARROWS F7D3 ARROW1 F7EC ARROW2 F7F3 ARROW3 F7FB OKKEY F802 NOKEY F81C YAID F827 WAID F82A NAID F839 BACK0 F862 BACK1 F872 BACK3 F875 BEGIN0 F88A BEGIN1 F89A BEGIN2 F8A3 BEGIN3 F8C2 FCTNUP F908 ENTER0 F90E CLRBUF F929 ENTR F941 ENTER1 F950 ENTER2 F96A NODIR F9A3 PORVI F9C7 DORF80 F9D8 XBPGM F9FE UPKEY FA0A GLESS FA14 GLESS2 FA16 DKEY FA29 GMORE FA3A LKEY FA3D LUPKEY FA49 LGLESS FA53 LGLES2 FA55 LOKKEY FA5F RKEY FA62 RDKEY FA75 RGMORE FA86 ROKKEY FA90 FLSCR FAA1 CATDAT FAAA HALVE FAB2 SCREEN FB42 CAT3 FB5B CAT4 FB6E CAT4A FB9B CAT4B FB9F FILNAM FBB0 CAT5 99/4 GPL-ASSEMBLER (Pass 3) correct PAGE 0055 E/A GROM FBD9 CAT5A FBE9 DF FBF9 DV FC09 IF FC19 IV FC29 PR FC39 DI FC4B CAT6 FC56 CAT7 FC62 SCROLL FC75 FILNA1 FC7A DISNUM FC80 DISNU1 FC8F DISNU2 FC9D DISSTR FCB7 VEIW40 FCBF MV40 FCF1 FREEZE FCF6 VOPEN FD16 DSREXT FD19 VCLOSE FD33 EADSR FD3A SEADSR FD41 XBDSR FD48 SXBDSR FD4F BASIC FD59 SBASIC 99/4 GPL-ASSEMBLER (Pass 3) correct PAGE 0056 E/A GROM Symbol Table #4 (Def,alpha) 0034 ACCTON 835C ARG 0032 ATN 0036 BADTON 003B BITREV 0012 CFI 0014 CNS 002C COS 0010 CSN 8372 DATSTK 0001 DIVZER 0003 ERRIOV 0006 ERRLOG 0005 ERRNIP 0002 ERRSNN 0004 ERRSQR 0028 EXP 834A FAC 0006 FADD 000A FCOMP 0009 FDIV 0008 FMUL 836C FPERAD 0007 FSUB 0038 GETSPACE 0022 INT 0010 LINK 0018 LOCASE 002A LOG 8370 MEMSIZ 003D NAMLNK 8300 PAD 0024 PWR 0012 RETURN 000B SADD 000F SCOMP 000E SDIV 8375 SGN 002E SIN 000D SMUL 8400 SOUND 0026 SQR 000C SSUB 837C STATUS 0016 STCASE 8373 SUBSTK 0030 TAN 0007 TRIGER 004A UPCASE 836E VSPTR 0001 WRNOV 837F XPT 837E YPT 99/4 GPL-ASSEMBLER (Pass 3) correct PAGE 0057 E/A GROM Symbol Table #8 (Def,value) 0001 DIVZER 0001 WRNOV 0002 ERRSNN 0003 ERRIOV 0004 ERRSQR 0005 ERRNIP 0006 ERRLOG 0006 FADD 0007 FSUB 0007 TRIGER 0008 FMUL 0009 FDIV 000A FCOMP 000B SADD 000C SSUB 000D SMUL 000E SDIV 000F SCOMP 0010 CSN 0010 LINK 0012 CFI 0012 RETURN 0014 CNS 0016 STCASE 0018 LOCASE 0022 INT 0024 PWR 0026 SQR 0028 EXP 002A LOG 002C COS 002E SIN 0030 TAN 0032 ATN 0034 ACCTON 0036 BADTON 0038 GETSPACE 003B BITREV 003D NAMLNK 004A UPCASE 8300 PAD 834A FAC 835C ARG 836C FPERAD 836E VSPTR 8370 MEMSIZ 8372 DATSTK 8373 SUBSTK 8375 SGN 837C STATUS 837E YPT 837F XPT 8400 SOUND 1 Quote Link to comment Share on other sites More sharing options...
+Ksarul Posted October 2, 2020 Share Posted October 2, 2020 Thanks, Rich! 1 Quote Link to comment Share on other sites More sharing options...
webdeck Posted October 2, 2020 Author Share Posted October 2, 2020 Thanks for sharing, Rich! 1 Quote Link to comment Share on other sites More sharing options...
Ed in SoDak Posted October 2, 2020 Share Posted October 2, 2020 On 9/27/2020 at 1:22 PM, webdeck said: Thanks for the pointer to the development resources thread - great stuff there. I'm surprised that more original source code hasn't surfaced over the years, like the GPL source for GROMs 0-2. TI Intern by Heimer Martin has the commented disassembly. Link copied from Retrocloud's essential Development Resources thread linked above. 1 Quote Link to comment Share on other sites More sharing options...
+Torrax Posted October 2, 2020 Share Posted October 2, 2020 The TI-99/4A Tech Pages has some disassembled listings. http://www.unige.ch/medecine/nouspikel/ti99/download.htm#disass 1 Quote Link to comment Share on other sites More sharing options...
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.