************************************************************* GROM >E000 AORG >0000 TITL 'Rich E/A GROM 2024' ************************************************************* * CPU * PAD EQU >8300 PAD1 EQU >8301 PAD2 EQU >8302 PAD3 EQU >8303 PAD4 EQU >8304 PAD6 EQU >8306 PAD7 EQU >8307 PAD8 EQU >8308 BYTES EQU >830C BYTES COUNTER SCADD EQU >8310 SCADE EQU >8311 TMPCNT EQU >8312 SCNADD EQU >8314 TMP EQU >8316 TMP1 EQU >8317 CHRCUR EQU >8318 PABPTR EQU >831C COUNT EQU >831E CATALOG COUNT FILES CURADD EQU >8320 CODE EQU >8322 CODE1 EQU >8323 STLN EQU >8324 ENDLN EQU >8326 BUFFR EQU >8328 PGMPTR EQU >832C FREPTR EQU >8340 XTOKEN EQU >8342 DSKFLG EQU >8344 LDFLAG EQU >8347 FLAG EQU >8348 FLAG2 EQU >8349 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 VPAB EQU >8356 ARG EQU >835C ARG1 EQU >835D ARG2 EQU >835E ARG4 EQU >8360 ARG6 EQU >8362 VSTACK EQU >836E SUBSTK EQU >8373 KBNO EQU >8374 KEY EQU >8375 ITIMER EQU >8379 VCHAR EQU >837D CHARNM EQU >83C0 SPRITE EQU >83C2 ******************** * GENERAL * AID EQU 1 CLEAR EQU 2 REDO EQU 6 PROCD EQU 12 ENTER EQU 13 BEGIN EQU 14 BACK EQU 15 SPACE EQU 32 * XML's ************ * ROUND EQU >02 CIF EQU >23 * VDP ************** * COLOR EQU >077F * GROM ************* * DSRLNK EQU >0010 DSRRET EQU >0012 BERR EQU >001C BGETSS EQU >0038 RXB EQU >6024 *********************************************************** * GROM Header BYTE >AA * Header byte BYTE 24 * Version # BYTE 1 * # programs BYTE 0 * Reserved DATA >0000 * POWER UP DATA MENU * Cartridge menu DATA EADSR * DSRs DATA BASICS * Subroutines DATA >0000 * Interupts DATA BASICS * TI BASIC MENU DATA >0000 DATA SETUP STRI 'REA 2024 ' ********************************************************* * Set up configure paths SETUP CEQ >99,V@>0CFF PREVIOUS RUN FLAG SET? BS SOLDEA Yes ST >99,V@>0CFF No, SET PREVIOUS RUN FLAG CLR V@>0D00 MOVE >FF,V@>0D00,V@>0D01 MOVE 11,G@C1,V@>0D00 DSK1.EDIT1 MOVE 11,G@C2,V@>0D28 DSK1.ASSM1 MOVE 12,G@C3,V@>0D50 DSK1.SOURCE MOVE 12,G@C4,V@>0D78 DSK1.OBJECT MOVE 10,G@C5,V@>0DA0 DSK1.LIST MOVE 2,G@C6,V@>0DC8 L * NORMAL RXB START OF EA MODULE SOLDEA CALL NESCRN OLDEA CHE >38,@XTOKEN Flag to high? BS CLREA Yes CHE >31,@XTOKEN Flag set? BS NEWEA yes CLREA CALL CLRREA CLR @XTOKEN Reset RXB flag CLR V@>3EF0 Clear RXB MENU Flag NEWEA DCLR @>2000 GE029 CALL EASCRN CLR @DSKFLG * Disk SEARCH FLAG DST >0B00,@FAC CALL UPCASE GE056 ST 5,@KBNO DST >0900,@FAC CALL LOCASE CLR V@>0800 MOVE >00FF,V@>0800,V@>0801 MOVE 6,G@VREGS,#1 CLR V@>1000 * CLEAR PAB AREAS MOVE >0380,V@>1000,V@>1001 AND >EF,@SPRITE Disable Sprites! MOVE 16,G@CURPAT,V@>08F0 MOVE 16,G@DARROW,V@>0C10 * * Display Main Menu * MMENU ST >7E,@SUBSTK * Set SUBSTACK DCLR @CODE DCLR @FLAG CLR @LDFLAG ALL SPACE GE116 CHE >38,@XTOKEN BS MSCRN CHE >31,@XTOKEN BS MYEAXB MSCRN HOME FMT COL 1 HTEX 'Rich Editor & Assembler 2024 ' ROW+ 1 COL 0 HCHA 32,95 ROW+ 2 COL 6 HTEX 'S SET PATH NAMES' ROW+ 4 COL 6 HTEX 'D DIRECTORY' ROW+ 3 COL 6 HTEX 'A ASSEMBLER' ROW+ 2 COL 6 HTEX 'E EDITOR' ROW+ 2 COL 6 HTEX 'X XB PROGRAM' ROW+ 2 COL 6 HTEX 'L LOAD and RUN' ROW+ 2 COL 6 HTEX 'P PROGRAM FILE' ROW+ 4 COL 6 HTEX '. R X B' FEND NEWSCN SCAN BR NEWSCN CEQ >2E,@KEY * .? BR NSCAN * Yes CALL CLSALL * Close files RTRXB B RXB * Go RXB MYEAXB DCLR V@>2250 * Clear Pass flag ST @XTOKEN,@KEY ST >EA,@XTOKEN * Load Flag NSCAN CEQ 'L',@KEY * L? BS NSCAN1 CEQ 'l',@KEY * l? BS NSCAN1 CEQ '3',@KEY * 3? BR NSCAN2 NSCAN1 ST >33,@KEY * Set LOAD & RUN CEQ >33,@KEY * LOAD AND RUN? BS LANDR NSCAN2 CEQ 'P',@KEY * P? BS NSCAN3 CEQ 'p',@KEY * p? BS NSCAN3 CEQ '5',@KEY * 5 BR NSCAN4 NSCAN3 ST >35,@KEY * SET RUN PROGRAM CEQ >35,@KEY * PROGRAM? BS PRGRM NSCAN4 CEQ 'A',@KEY * A? BS NSCAN5 CEQ 'a',@KEY * a? BS NSCAN5 CEQ '2',@KEY * 2? BR NSCAN6 NSCAN5 ST >32,@KEY * SET ASSEMBLER CEQ >32,@KEY * ASSEMBLER? BS ASSEM NSCAN6 CEQ 'E',@KEY * E? BS NSCAN7 CEQ 'e',@KEY * e? BS NSCAN7 CEQ '1',@KEY * 1? BR NSCAN8 NSCAN7 ST >31,@KEY * SET EDITOR CEQ >31,@KEY * EDITOR? BS EDITOR NSCAN8 CEQ 'D',@KEY * D? BS DIRECT CEQ 'd',@KEY * d? BS DIRECT CEQ 'X',@KEY * X? BS XBINP CEQ 'x',@KEY * x? BS XBINP CEQ 'S',@KEY * S? BS CONFIG CEQ 's',@KEY * s? BR NEWSCN ****************************************************** * CONFIGURE PATHS * CONFIG CALL EASCRN CLR @XTOKEN CALL CLRREA ALL SPACE HOME FMT COL 6 HTEX '* CONFIGURE PATHS *' FEND ST 49,V@65 1 MOVE 40,V@>0D00,V@67 DSK1.EDIT1 ST 50,V@161 2 MOVE 40,V@>0D28,V@163 DSK1.ASSM1 ST 51,V@257 3 MOVE 40,V@>0D50,V@259 DSK1.SOURCE ST 52,V@353 MOVE 40,V@>0D78,V@355 DSK1.OBJECT ST 53,V@449 5 MOVE 40,V@>0DA0,V@451 DSK1.LIST FMT ROW 17 COL 1 HTEX '6 OPTIONS:' ROW 21 COL 4 HTEX 'CTRL 1 - 5 DRIVE SELECTION' ROW 23 COL 4 HTEX 'ANY OTHER KEY TO MAIN MENU' FEND MOVE 40,V@>0DC8,V@556 OPTIONS: L CONFIH SCAN BR CONFIH CHE '7',@KEY <7? BS CONFIL Exit out CHE '1',@KEY 1 to 6 only valid BR CLREA Exit out DST 65,@CURADD Cursor Location CHE >30,@KEY KEY>48? BR CONFIH SUB >30,@KEY KEY-48 ST @KEY,@PAD Save key 0-5 ST @KEY,@PAD8 Save key 1-6 DEC @PAD -1 MUL 96,@PAD Add 64 Cursor Address DADD @PAD,@CURADD Cursor address ST 130,V*CURADD Left Arrow DADD 35,@CURADD Cursor DST @CURADD,@PAD4 Save address CONFIJ CALL GETINP Get input DCZ @FAC6 Length 0? BS CONFIG CHE 39,@FAC <39? BS CONFIG DCLR @PAD6 Index CONFIK DADD 40,@PAD6 Index+40 DEC @PAD8 Copy of KEY BR CONFIK ST @FAC7,V@>0CD8(@PAD6) Length MOVE 39,V*PAD4,V@>0CD9(@PAD6) String BR CONFIG MMMENU ST >EA,@XTOKEN Set flag BR MMENU Exit * CTRL keys *************************************** CONFIL CHE 182,@KEY CTRL 5? BS CONFIG CHE 177,@KEY BR CONFIG CALL ACCTON ACCEPT TONE ST @KEY,@PAD4 SAVE KEY SUB 176,@PAD4 CTRL=1 to 5 DCLR @ARG DST -25,@PAD SCREEN ADDRESS DST >0CDC,@ARG MEMORY ADDRESS CONFLP DADD 40,@ARG 40*VALUE DADD 96,@PAD 96*VALUE DEC @PAD4 BR CONFLP ST 30,@PAD6 CONDEU DST >0160,@PAD2 COUNTER CONDEV SCAN BS CONDST DDEC @PAD2 COUNTER-1 BR CONDEV EX V*PAD,@PAD6 SWAP B CONDEU CONDST CALL ACCTON ST @KEY,V*PAD SCREEN ADDRESS # ST @KEY,V*ARG MEMORY ADDRESS # BR CONFIG ************************************************** * Main Menu Option 1: EDIT * EDITOR CALL EASCRN DCLR @FLAG CLR @LDFLAG ST >EA,@XTOKEN FMT COL >0B ROW 1 HTEX '* EDITOR *' ROW+ 3 COL 3 HTEX '1 LOAD' ROW+ 1 COL+ 23 HTEX '2 EDIT' ROW+ 1 COL+ 23 HTEX '3 SAVE' ROW+ 1 COL+ 23 HTEX '4 PRINT' ROW+ 1 COL+ 22 HTEX '5 PURGE' ROW+ 1 COL+ 22 FEND GE19B SCAN BR GE19B CEQ BACK,@KEY * BACK KEY BS CLREA SUB >31,@KEY CHE >06,@KEY BS GE19B DCLR @FLAG ST >7E,@SUBSTK ST @KEY,@PAD * Save KEY MUL >40,@PAD DST >0082,@CURADD DADD @PAD,@CURADD ST 130,V*CURADD * SHOW ARROW ST @KEY,@PAD4 CEQ 4,@KEY * PURGE? BR GE1E4 * No, next check * Edit Menu Option 5: PURGE FMT ROW+ 2 HTEX 'Are you sure (Y/N)? ' FEND CALL YESNO CEQ >59,@KEY BR EDITOR CALL CLRXOP GE1E2 BR EDITOR GE1E4 CEQ >03,@KEY * PRINT? BS GE237 * YES! DCEQ >55AA,@>2000 * EDIT1 loaded? BS GE1FC * Yes MOVE 99,V@>2250,@>EA00 ST @XTOKEN,@>FFFB CALL P1000 CALL NPAB MOVE 40,V@>0D00,V@>1009 Get configured path EDIT1 ST 1,@LDFLAG Set Editor flag GE1F6 CALL PGMLOD DCEQ >55AA,@>2000 BR EDITOR CALL CLRXOP MOVE 99,@>EA00,V@>2250 ST @>FFFB,@XTOKEN GE1FC CEQ >01,@PAD4 * Edit? BS EMOPT2 * Yes CEQ >02,@PAD4 * Save? BR GE237 * No * Edit Menu Option 3: SAVE CLR @XTOKEN FMT COL 2 ROW 16 HTEX 'DV80 Format (Y/N)? ' FEND CALL YESNO CEQ >59,@KEY BR GE22C OR >02,@FLAG2 GE22C CEQ BACK,@KEY BS EDITOR DST >0262,@CURADD BR GE23B GE235 CLR @XTOKEN * CLEAR XTOKEN FLAG GE237 DST >0202,@CURADD * Print or Load MOVE 255,V@>0200,V@>201 GE23B MOVE 10,G@FPATH,V*CURADD DADD >0040,@CURADD * CONFIGURE PATH SOURCE ********************************* DCLR @TMP ST V@>0D50,@TMP1 DST @TMP,V@>2255 MOVE @TMP,V@>0D51,V@>2257 Save as SOURCE ST >0D,V@>2258(@TMP) CHE >02,@PAD4 SAVE, PRINT ? BS EINPUT CEQ >EA,@XTOKEN BS EINPUT BR EINPUT CALL BLNKBU CALL BLDPAB BR EMOPT1 EINPUT CALL GETALL EMOPT1 CEQ BACK,@KEY * BACK? BS CLREA CEQ >02,@PAD4 * Save? BS GE2B5 CEQ >03,@PAD4 * Print? BS GE2D9 CZ @PAD4 * Load? BS GE272 * Edit Menu Option 2: EDIT EMOPT2 XML >23 BS GE8B0 CALL GE8FC BR EDITOR GE272 ST >EA,@XTOKEN SET XTOKEN CALL GE27B XML >21 BS GE8B3 BR EDITOR ********************************************* GE27B ST >04,V@1(@PABPTR) AND >FD,@FLAG2 GE283 DST @PABPTR,@VPAB DADD >0009,@VPAB CALL DSRLNK BYTE >08 BS CHKERR CLOG >E0,V@1(@PABPTR) BR GE29C ST >02,V*PABPTR RTN ********************************************** GE29C ST V@1(@PABPTR),@PAD AND >1F,@PAD CEQ >04,@PAD BR GE2B3 ST >14,V@1(@PABPTR) OR >02,@FLAG2 BR GE283 GE2B3 BR CHKERR GE2B5 ST >02,V@1(@PABPTR) CLOG >02,@FLAG2 BS GE2C4 ST >12,V@1(@PABPTR) GE2C4 CALL DOIO ST >03,V*PABPTR ST >50,V@5(@PABPTR) XML >22 BS GE8B3 CALL CLOSE BR EDITOR * Edit Menu Option 4 : PRINT output GE2D9 CALL GE27B FMT COL 2 ROW 20 HTEX 'DEVICE NAME?' FEND DST >02C2,@CURADD * Cursor Address DST >1100,@PABPTR * PAB address CEQ >04,@PAD4 * VIEW? BS VFILE * No CLR @XTOKEN CALL CLRREA VFILE CALL GETALL CLR @XTOKEN ST >50,V@5(@PABPTR) GE30A ST >12,V@1(@PABPTR) DST >1080,V@2(@PABPTR) CALL DOIO CEQ >20,V@4(@PABPTR) BR GE322 OR >02,@FLAG GE322 ST >03,V*PABPTR CLOG >02,@FLAG BS GE38D GE32B CALL P1000 CALL BLNKBU CALL DOIO DST >1100,@PABPTR DST >1080,@PAD DADD >004F,@PAD ST >50,@PAD2 GE344 ST V*PAD,@PAD3 CEQ >20,@PAD3 BS GE361 CEQ >0C,@PAD3 BR GE35F ST >20,V*PAD CALL DOIO CALL DOIO CALL DOIO GE35F BR GE367 GE361 DDEC @PAD DEC @PAD2 BR GE344 GE367 CALL DOIO SUB >20,@PAD2 CGT >00,@PAD2 BR GE380 DADD >0020,V@2(@PABPTR) ST @PAD2,V@5(@PABPTR) B GE367 GE380 DST >1080,V@2(@PABPTR) ST >20,V@5(@PABPTR) BR GE32B GE38D CALL P1000 CALL BLNKBU CALL DOIO DST >1100,@PABPTR CALL DOIO BR GE38D GETALL CALL BLNKBU * Build PAB with name BLDPAB CALL VZERO DST @PABPTR,V@2(@PABPTR) DADD >0080,V@2(@PABPTR) ST >00,V@8(@PABPTR) DST >5000,V@4(@PABPTR) DCLR V@>2250 CALL GETINP DCZ @FAC6 BS GE3CF PABNAM MOVE @FAC6,V*FAC4,V@10(@PABPTR) ST @FAC7,V@9(@PABPTR) GE3CF RTN BLNKBU DADD >0080,@PABPTR ST >20,V*PABPTR MOVE >004F,V*PABPTR,V@1(@PABPTR) DSUB >0080,@PABPTR RTN CLOSE ST >01,V*PABPTR DOIO DST @PABPTR,@VPAB DADD >0009,@VPAB CALL DSRLNK BYTE >08 BS CHKERR CLOG >E0,V@1(@PABPTR) BR CHKERR RTN VZERO CLR V*PABPTR MOVE >0045,V*PABPTR,V@1(@PABPTR) RTN GETINP CALL GETKEY DST @STLN,@CURADD ST >3C,@PAD DCLR @FAC6 GE415 CEQ SPACE,V*CURADD BR GE42B DINC @CURADD DEC @PAD BR GE415 DST @STLN,@CURADD CLOG >04,@FLAG BR GE43C BR GETINP GE42B DST @CURADD,@FAC4 GE42E CEQ SPACE,V*CURADD BS GE43C DINC @FAC6 DINC @CURADD DEC @PAD BR GE42E GE43C RTN * Key input routine GETKEY ST >1F,@CHRCUR DST @CURADD,@ENDLN DST @CURADD,@STLN GE446 CLR @ITIMER EX V*CURADD,@CHRCUR * REPEAT KEYS GE44C SCAN BS GE456 CHE 7,@ITIMER BR GE44C CEQ >EA,@XTOKEN * ANYTHING BR GE446 PSCANX DST V@>2250,@BUFFR ST V@>2257(@BUFFR),@KEY DINC @BUFFR DST @BUFFR,V@>2250 CEQ @BUFFR,V@>2256 BR GE456 ST >0D,@KEY * Store ENTER GE456 CEQ >1F,V*CURADD BR GE460 EX V*CURADD,@CHRCUR GE460 DST @CURADD,@PAD DSUB @STLN,@PAD CH >19,@KEY * SPACE key and higher? BS GE46B CEQ 7,@KEY * FCTN 3? BR GE485 ST SPACE,V*STLN MOVE >003F,V*STLN,V@1(@STLN) DST @STLN,@CURADD BR GETKEY GE46B CLOG >01,@FLAG BR GE4DD GE470 ST @KEY,V*CURADD DCH @ENDLN,@CURADD BR GE47C DST @CURADD,@ENDLN GE47C CH >3F,@PAD1 BS GE446 DINC @CURADD BR GE446 GE485 AND >FE,@FLAG CEQ BACK,@KEY BR GE499 CLOG >20,@FLAG BR CLREA * GE97F CLOG >04,@FLAG BR CLREA BR EDITOR GE499 CEQ >09,@KEY BS GE47C CEQ >08,@KEY BR GE4AB CZ @PAD1 BS GE446 DDEC @CURADD BR GE446 GE4AB CEQ >0D,@KEY BS GE503 CEQ >03,@KEY BR GE4D3 ST SPACE,V*CURADD DST @ENDLN,@PAD DSUB @CURADD,@PAD CGT >00,@PAD1 BR GE446 MOVE @PAD,V@1(@CURADD),V*CURADD ST SPACE,V*ENDLN DDEC @ENDLN BR GE446 GE4D3 CEQ >04,@KEY BR GE501 OR >01,@FLAG BR GE446 GE4DD DST @ENDLN,@PAD DSUB @STLN,@PAD CH >3F,@PAD1 BS GE446 DST @ENDLN,@PAD DSUB @CURADD,@PAD DINC @PAD MOVE @PAD,V*CURADD,V@>03C0 MOVE @PAD,V@>03C0,V@1(@CURADD) DINC @ENDLN BR GE470 GE501 BR GE446 GE503 RTN * Check for Expansion Memory EXPMEM ST @>2000,@PAD ST >FF,@>2000 CEQ >FF,@>2000 BR GE91D CLR @>2000 CZ @>2000 BR GE91D ST @PAD,@>2000 RTN NESCRN BACK >F4 ST >F4,V@COLOR EASCRN ST >D0,V@>0300 ST V@COLOR,V@>0380 MOVE 31,V@>0380,V@>0381 ALL SPACE MOVE 1,V@COLOR,#7 RTN USSCRN ST >13,V@>0380 MOVE 31,V@>0380,V@>0381 ALL SPACE RTN CLRXOP CLR @>FFD8 MOVE 5,@>FFD8,@>FFD9 RTN *********************************************************** * * Main Menu Option 2: ASSEMBLER * ASSEM ALL SPACE FMT COL 10 ROW 1 HTEX '* ASSEMBLER *' FEND DCLR @FLAG CLR @LDFLAG ST >7E,@SUBSTK OR >20,@FLAG DCEQ >AA55,@>2000 BS GE687 MOVE 99,V@>2250,@>EA00 ST @XTOKEN,@>FFFB CLR @XTOKEN * Replacement for LODPGM * CALL LODPGM * DATA DASSM1 * CALL DEVICE * CEQ BACK,@KEY * BS CLREA CALL P1000 MOVE 15,G@PAB,V*PABPTR MOVE 40,V@>0D28,V@>1009 Get configured path ASSM1 ST 2,@LDFLAG GE654 CALL PGMLOD DCEQ >AA55,@>2000 BR ASSEM * CALL FILES (4) GE687 DST >0116,V@>1380 DST >1380,@VPAB ST >04,@FAC2 CALL DSRLNK BYTE >0A MOVE 99,@>EA00,V@>2250 ST @>FFFB,@XTOKEN ALL 32 FMT COL 10 ROW 1 HTEX '* ASSEMBLER *' FEND CALL P1000 ** CONFIGURE PATH SOURCE ************************ CALL VZERO CALL LPAB DST >1080,V@2(@PABPTR) ST >00,V@8(@PABPTR) DST >5000,V@4(@PABPTR) DCLR V@>2250 MOVE 40,V@>0D50,V@9(@PABPTR) DST >1080,V@2(@PABPTR) CALL GE27B CLR @XTOKEN DST >1100,@PABPTR DST >0142,@CURADD ** CONFIGURE PATH OBJECT ************************* CALL VZERO CALL LPAB ST >00,V@1(@PABPTR) DST >1180,V@2(@PABPTR) ST >00,V@8(@PABPTR) DST >5000,V@4(@PABPTR) DCLR V@>2250 MOVE 40,V@>0D78,V@9(@PABPTR) DST >1180,V@2(@PABPTR) CALL DOIO OR >40,@FLAG DST >1200,@PABPTR OR >04,@FLAG ** CONFIGURE PATH LIST ************************** CALL VZERO CALL LPAB ST >12,V@1(@PABPTR) DST >1280,V@2(@PABPTR) ST >00,V@8(@PABPTR) DST >5000,V@4(@PABPTR) DCLR V@>2250 MOVE 40,V@>0DA0,V@9(@PABPTR) DCZ @FAC6 BS GE736 ST >12,V@1(@PABPTR) DST >1280,V@2(@PABPTR) CALL DOIO OR >80,@FLAG GE736 FMT COL 2 ROW 16 HTEX 'Options?' FEND DST >0242,@CURADD ** CONFIGURE PATH OPTIONS ******************** MOVE 20,V@>0DC9,V@>03C0 AND >FB,@FLAG DCZ @FAC6 BR GE756 GE756 MOVE 15,V@>0DC9,@>20D2 CALL CLRXOP ALL SPACE XML >21 BS GE8B3 GE767 CALL CLRXOP CALL P1000 CALL CLOSE DST >1100,@PABPTR CALL CLOSE CLOG >80,@FLAG BS GE784 DST >1200,@PABPTR CALL CLOSE GE784 CLR @FLAG CALL WENTER BR OLDEA * Get Yes/No reply YESNO ST >1F,@CHRCUR GE7A2 CLR @ITIMER EX @VCHAR,@CHRCUR GE7A7 SCAN BS GE7B1 CHE >06,@ITIMER BR GE7A7 BR GE7A2 GE7B1 CEQ BACK,@KEY BS GE7C0 CEQ >59,@KEY BS GE7C0 CEQ >4E,@KEY BR GE7A2 GE7C0 ST @KEY,@VCHAR CLR @XTOKEN RTN *************************************************** * Main Menu Option 3: LOAD AND RUN * LANDR DCLR @FLAG OR >01,@FLAG2 ALL SPACE FMT COL 8 ROW 0 HTEX '* LOAD and RUN *' COL+ 10 ROW+ 2 HTEX 'PATH.NAME?' FEND CALL EXPMEM OR >40,@FLAG2 GE7F2 ST SPACE,V@162 MOVE >003B,V@162,V@163 DST 162,@CURADD OR >04,@FLAG CALL P1000 CALL GETALL CLR @XTOKEN DCZ @FAC6 BR GE816 CALL BINIT2 BR RUN BR GE821 GE816 CLOG >40,@FLAG2 BS GE821 CALL BINIT3 AND >BF,@FLAG2 GE821 ST >04,V@1(@PABPTR) GE826 DST @PABPTR,@VPAB DADD >0009,@VPAB XML >22 CLOG >08,@FLAG BR G6C61 to subs BR GE7F2 next file *************************************************** * Main Menu Option 4: RUN * RUN ALL SPACE GE848 ST >7E,@SUBSTK FMT ROW 0 COL 1 HTEX '* RUN *' ROW+ 2 COL 1 HTEX 'SELECT PROGRAM NAME:' FEND CALL EXPMEM CLR @XTOKEN SET XTOKEN=0 DST 129,@PAD6 * Screen location LOCATION DST >3FF8,@PAD8 * Locataion of LINK TABLE FNDLNK DST @PAD8,@PAD2 * Copy it. ST 6,@PAD4 * MAX Length of each name. FNDLP CHE 128,@0(@PAD2) * ~? BS FNDDON * Yes, done. CHE 32,@0(@PAD2) * Space or higher? BR FNDDON * No, done. CEQ 32,@0(@PAD2) * Space? BR FNDSHO * No. CEQ 6,@PAD4 * 6? BS FNDDON * Yes. FNDSHO ST @0(@PAD2),V@0(@PAD6) DINC @PAD6 * COL+1 DCHE 768,@PAD6 * End of screen? BR MORSCN MOVE 20,G@OUTSCN,V@>8 CALL BADTON BR FNDDON * MORSCN DINC @PAD2 * Next character. DEC @PAD4 * Length-1 BR FNDLP * No, keep looping. DINCT @PAD6 * Reset next column DSUB 8,@PAD8 * Link Table Address+8 CEQ >2600,@PAD8 * Last Table name? BR FNDLNK * No * Get the name by using arrow keys FNDDON OR >04,@FLAG DST >0080,@SCADD ARROW LOCATION RUN00 ST 130,V*SCADD LEFT ARROW ST 131,V@7(@SCADD) RIGHT ARROW SCAN BR RUN00 ST 32,V*SCADD NO LEFT ARROW ST 32,V@7(@SCADD) NO RIGHT ARROW CEQ BACK,@KEY BACK? BS LANDR CEQ 11,@KEY FCTN UP? BS RUNUP CEQ 'E',@KEY UP (E)? BR RUN01 RUNUP DSUB 32,@SCADD ARROW-8 DCHE >007F,@SCADD TOP LINE LEFT? BR FNDDON RUN01 CEQ 10,@KEY FCTN DOWN? BS RUNDN CEQ 'X',@KEY DOWN (X)? BR RUN02 RUNDN DADD 32,@SCADD ARROW+8 DCHE 767,@SCADD BOTTON LINE RIGHT? BS FNDDON DCEQ >2020,V@1(@SCADD) SPACE SPACE? BR RUN02 DSUB 32,@SCADD ARROW-8 RUN02 CEQ 8,@KEY FCTN LEFT? BS RUNLT CEQ 83,@KEY LEFT (S)? BR RUN03 RUNLT DSUB 8,@SCADD ARROW-32 DCHE >007F,@SCADD TOP LINE LEFT? BR FNDDON RUN03 CEQ 9,@KEY FCTN RIGHT? BS RUNRT CEQ 68,@KEY RIGHT (D)? BR RUN04 RUNRT DADD 8,@SCADD ARROW+8 DCHE 767,@SCADD BOTTOM LINE RIGHT? BS FNDDON DCEQ >2020,V@1(@SCADD) SPACE SPACE? BR RUN04 DSUB 8,@SCADD ARROW-8 RUN04 CEQ ENTER,@KEY ENTER? BS RUN05 BR RUN00 * Fetch the name match and address RUN05 MOVE 6,V@1(@SCADD),@FAC DST >4000,@TMP * Locataion of LINK TABLE RUN06 DSUB 8,@TMP * MINUS offset MOVE 8,@0(@TMP),@ARG * Copy it. DCEQ @FAC,@ARG * First two characters? BR RUN06 DCEQ @FAC2,@ARG2 * Secod two characters? BR RUN06 DCEQ @FAC4,@ARG4 * Third two characters? BR RUN06 MOVE 2,@ARG6,@>2022 * Normal EA 3 start up GE883 DCEQ >A55A,@>2000 BR GE916 CALL USSCRN GE88E DCLR @CODE XML >21 BS GE8E3 CLOG >20,@FLAG2 BS GE8A3 INCT @SUBSTK DST GE88E,*SUBSTK INCT @SUBSTK RTN GE8A3 CLOG >08,@FLAG BR G6DDE to subs GE8A8 CALL SOLDEA vdp setup CALL WENTER wait for enter BR GE029 to start *************************************************** * * Main Menu Option 5: RUN PROGRAM FILE * PRGRM ALL SPACE FMT COL 6 ROW 1 HTEX '* RUN PROGRAM FILE *' FEND CEQ >FF,@XTOKEN RXB flag set? BR NOEABF No MOVE 64,V@>2400,V@>2255 Get RXB buffer ST >EA,@XTOKEN Set RXB flag NOEABF CALL BINIT2 * INITILIZE LOW8K OR >08,@FLAG2 Set flag DST >0102,@CURADD Cursor address MOVE 10,G@FPATH,V*CURADD * FILE NAME? DADD >0040,@CURADD Cursor address+64 OR >04,@FLAG Set flag CALL GETINP Get path.file CEQ 1,@FAC7 Length=1? BR NO1KEY No DST >000B,V@>2400 Length CALL GDDSK Load DSK1. Address MOVE 6,G@DUTIL1,V@>2407 Load UTIL1 ST >FF,@XTOKEN Set RXB flag BR PRGRM Restart NO1KEY DCZ @FAC6 * ENTER? BR GE597 * No ST '1',@DSKFLG * Search flag MYSRCH CALL LODPGM * Load DATA DATA DUTIL1 * DSK1.UTIL1 BR GE5A6 GE597 CALL LODUSR CALL PABNAM DCEQ >4353,V*FAC4 * CS ?? BR GE5A6 * No ALL SPACE GE5A6 CALL PGMLOD CALL USSCRN XML >F0 BS GE8E3 BR GE8A8 LODPGM FETCH @SCADD FETCH @SCADE MOVE 5,G@0(@SCADD),V@>100F LODUSR DCLR @PAD CALL P1000 CALL NPAB CZ @DSKFLG * Check Search flag BS PMSG * No, go on ST @DSKFLG,V@13(@PABPTR) * Yes, store next drive # PMSG MOVE 15,G@PLEASE,V@>02A2 RTN * Load Program PGMLOD CALL DOIO MOVE 6,V@>1380,@SCADD DCZ @PAD BR GE5E5 DST @SCNADD,@PAD GE5E5 DSUB PAD,@SCNADD MOVE @TMPCNT,V@>1386,@PAD(@SCNADD) DCZ @SCADD BS GE605 DCLR @PAD2 ST V@>1009,@PAD3 DADD >1009,@PAD2 INC V*PAD2 BR PGMLOD GE605 ST SPACE,V@>02A2 MOVE 19,V@>02A2,V@>02A3 CALL VZERO RTN ******************************************************** * RXB Loader XBINP ALL SPACE ST 1,@FAC XBAGN FMT COL 8 ROW 1 HTEX '* R X B *' ROW+ 4 COL 2 HTEX 'PATH.NAME?' FEND DEC @FAC BR XBAGN CEQ >FF,@XTOKEN XTOKEN=>EA? BR XBINP1 MOVE 64,V@>2400,V@>2255 ST >EA,@XTOKEN SET XTOKEN=>EA XBINP1 DST >0102,@CURADD DST >1000,@PABPTR OR >20,@FLAG CALL GETALL DCZ @FAC6 BS XBINP3 CEQ 1,@FAC7 BR XBINP2 DST >000A,V@>2400 MOVE 5,G@DDSK1,V@>2402 ST V*STLN,V@>2405 MOVE 5,G@DLOAD,V@>2407 ST >FF,@XTOKEN SET XTOKEN=>FF BR XBINP XBINP2 CALL CLRREA DST >994A,V@>2254 MOVE 80,V@9(@PABPTR),V@>2256 XBINP3 CLR @PAD MOVE >006E,@PAD,@PAD1 B RXB *********************************************************** CLRREA CLR V@>2250 Clear RXB buffer MOVE 80,V@>2250,V@>2251 Ripple RTN ONEKEY CEQ 1,V@9(@PABPTR) One character for drive#? BR TWOKEY No, normal continue ST V@10(@PABPTR),@CHARNM Yes, save # character MOVE 5,G@DDSK1,V@10(@PABPTR) DSK1. loaded into pab ST >05,V@9(@PABPTR) DSK1. has 5 characters ST @CHARNM,V@13(@PABPTR) Load charcter drive#/le TWOKEY RTN * NPAB MOVE 20,G@PAB,V*PABPTR RTN * LPAB MOVE 10,G@PAB80,V*PABPTR RTN * GDDSK CEQ '0',V@>0142 BR GDDSKN MOVE 5,G@WDS1,V@>2402 ST '1',V@>0142 BR GDWDS GDDSKN MOVE 5,G@DDSK1,V@>2402 GDWDS ST V*STLN,V@>2405 RTN *********************************************************** * * CATALOG HARD/DISK * DIRECT CALL DMENU BR DIREC2 DMENU ALL SPACE Clear screen FMT COL 9 ROW 0 HTEX '* DIRECTORY * ' ROW+ 4 COL+ 10 HTEX 'Device? (# or path)' ROW+ 7 COL 2 HTEX 'ACTIVE KEYS: CLEAR, BEGIN,' ROW+ 2 COL 2 HTEX 'BACK, PROCEED, REDO, AID,' ROW+ 2 COL 2 HTEX '(Arrows), E,e,X,x,S,s,D,d,' ROW+ 2 COL 2 HTEX '1 (Editor), 2 (Assembler),' ROW+ 2 COL 2 HTEX 'ENTER (Program Image autorun)' ROW+ 2 COL 2 HTEX 'SPACE BAR (XB autorun only)' FEND RTN DIREC2 DST >0102,@CURADD Prompt location DST >1000,@PABPTR Use first PAB area OR >20,@FLAG Set return bit for error CALL GETALL Input the filename DIREC3 CLR @XTOKEN CALL CLRREA MOVE 9,G@CATDAT,V*PABPTR Prepare PAB CALL ONEKEY CALL DOIO Open the file DST >020D,V*PABPTR Read opcode to PAB CALL DOIO Read first record ALL SPACE Clear screen again CALL SCREEN Set up header ST >20,V@>2500 MOVE >1100,V@>2500,V@>2501 DST >2580,@FREPTR ST >59,@PAD2 Y TSTKEY SCAN Scan the keyboard BR TSTKE5 Any key? CEQ SPACE,@KEY SPACE KEY? BS TSTKE4 Yes, wait. CEQ BACK,@KEY BACK key? BR TSTKE3 No TSTKE2 CLR @XTOKEN Yes, so restart CALL CLOSE Close disk BR DIRECT Start Catalog again TSTKE3 CLR @XTOKEN Clear flag BR ARROWS TSTKE4 SCAN Wait for any key. BR TSTKE4 Loop TSTKE5 CALL DOIO Read file info CALL FILNAM Put it on screen BR TSTKEY Loop till done DEC @COUNT COUNT-1 ARROWS CALL CLRFAC ST @COUNT,@FAC1 DCHE 100,@FAC BR ARROW1 DSUB 100,@FAC ST 49,V@28 Show it 1__ ARROW1 DCHE 9,@FAC BR ARROW2 DIV 10,@FAC ADD >30,@FAC ST @FAC,V@29 Show it _#_ ADD >30,@FAC1 ST @FAC1,V@30 Show it __# BR ARROW3 ARROW2 ADD >30,@FAC1 ST @FAC1,V@30 ARROW3 DST >0081,@SCADD Arrows location DST >2580,@PAD4 Recall buffer OKKEY MOVE >0260,V*PAD4,V@>0080 Fill screen NOKEY ST 130,V*SCADD Left arrow ST 131,V@11(@SCADD) Right arrow SCAN CEQ AID,@KEY AID BR NAID MOVE 768,V@0,V@>2000 Save screen CALL DMENU YAID SCAN Any key? BR YAID No. MOVE 768,V@>2000,V@0 Restore screen WAID SCAN Any key? BR WAID NAID CEQ CLEAR,@KEY CLEAR BS TSTKE2 CEQ PROCD,@KEY PROCEED BS ENTER0 CEQ REDO,@KEY REDO BS TSTKE2 BACK0 CEQ BACK,@KEY BACK BR BEGIN0 DCEQ 'DS',V@>100A DS? DISK ONLY? BS TSTKE2 CALL CLRBUF Clear buffers and FAC DST V@>1008,@FAC Get length DCEQ 5,@FAC DSK#. or SCS#. or WDS#. BS BEGIN3 DCHE 4,@FAC BR BEGIN3 CALL CLRBUF Clear buffers and FAC DST V@>1008,@FAC Get length BACK1 DDEC @FAC Length -1 CEQ >2E,V@>1009(@FAC) .? BR BACK1 No, keep searching DCHE 5,@FAC DSK. or SCS. or WDS. or DSK#. BS BEGIN3 BACK3 ST BEGIN,@KEY BEGIN0 CEQ BEGIN,@KEY BEGIN BR FCTNUP CALL CLRFAC Clear buffers and FAC DST V@>1008,@FAC Get length DCEQ 5,@FAC DSK#. or SCS#. or WDS#. BS BEGIN2 DCLR @FAC Clear FAC BEGIN1 DINC @FAC COUNT +1 CEQ >2E,V@>1009(@FAC) .? BR BEGIN1 No, keep searching DCEQ 4,@FAC DSK. Length? BS BEGIN1 Yes, look for Volume. BEGIN2 DINC @FAC LENGTH+1 DST >0D0D,V@>1009(@FAC) BEGIN3 DST @FAC,V@>1008 DADD 2,@FAC MOVE @FAC,V@>1008,V@>2255 MOVE @FAC,V@>1008,V@>2400 ST >37,@XTOKEN B OLDEA FCTNUP CEQ 11,@KEY FCTN UP? BS UPKEY CEQ 'E',@KEY E? BS UPKEY CEQ 'e',@KEY e? BS UPKEY CEQ 10,@KEY FCTN DOWN? BS DKEY CEQ 'X',@KEY X? BS DKEY CEQ 'x',@KEY x? BS DKEY CEQ 8,@KEY FCTN LEFT? BS LKEY CEQ 'S',@KEY S? BS LKEY CEQ 's',@KEY s? BS LKEY CEQ 9,@KEY FCTN RIGHT? BS RKEY CEQ 'D',@KEY D? BS RKEY CEQ 'd',@KEY d? BS RKEY CEQ ' ',@KEY SPACE BAR BS ENTER0 CEQ 'A',@KEY A? BS ENTER0 CEQ 'a',@KEY a? BS ENTER0 CEQ 'G',@KEY G? BS ENTER0 CEQ 'g',@KEY g? BS ENTER0 CEQ ENTER,@KEY ENTER BS ENTER0 CEQ '1',@KEY 1=EDITOR BR NOKEY ENTER0 CALL CLRBUF ENTR DST V@>1008,@PAD6 Get length of device ST >2E,V@>1009(@PAD6) MOVE @PAD6,V@>100A,V@>2402 DST @SCADD,@FAC2 INC @SCADE ENTER1 INC @FAC3 Index+1 INC @FAC1 Count+1 CEQ SPACE,V*FAC2 Space? BS ENTER2 Yes CEQ 11,@FAC1 To long? BR ENTER1 ENTER2 ST ENTER,V*FAC2 cr DCEQ 'Di',V@16(@SCADD) ; Directory? BR NODIR No CEQ 'r',V@18(@SCADD) BR NODIR DST >2E0D,V*FAC2 .cr INC @FAC Count+1 NODIR MOVE @FAC,V*SCADD,V@>100A(@PAD6) DADD @PAD6,@FAC MOVE @FAC,V@>100A,V@>2257 DST @FAC,V@>2255 INC @PAD7 DST @PAD6,V@>2400 CALL CLOSE ST >EA,@XTOKEN Set flag CEQ 32,@KEY SPACE BAR BS XBPGM DCEQ 'Di',V@16(@SCADD) Directory? BR PORVI CEQ 'r',V@18(@SCADD) BS DIRECT PORVI CEQ 'P',V@16(@SCADD) Program? BS PRGRM CEQ 'V',V@20(@SCADD) Variable? BR DORF80 CEQ 'I',V@16(@SCADD) Internal? BR DORF80 DCEQ '25',V@24(@SCADD) Length 25_? BR DORF80 CEQ '4',V@26(@SCADD) Length 254? BS XBINP DORF80 DCEQ '80',V@25(@SCADD) Length 80? BR DF80 ************************** Save as SOURCE ******* DCLR @TMP ST @TMP,V@>0D50 clear byte at setup MOVE 39,V@>0D50,V@>0D51 Ripple it ST V@>2256,@TMP1 Get length byte DEC @TMP1 Length-1 ST @TMP1,V@>0D50 Get length byte MOVE @TMP,V@>2257,V@>0D51 Save as SOURCE CALL CLRXOP CLEAR EDIT BUFFER ****************************** DF80 CEQ 'F',V@20(@SCADD) Fixed? BS LANDR LEAASM CEQ 'A',@KEY Assemble file BS ASSEM CEQ 'G',@KEY GPL Assemble file BS ASSEM BR MMENU XBPGM CEQ 'P',V@16(@SCADD) Program? BS XBINP CEQ 'V',V@20(@SCADD) Variable? BR MMENU CEQ 'I',V@16(@SCADD) Internal? BR MMENU DCEQ '25',V@24(@SCADD) Length 25_? BR MMENU CEQ '4',V@26(@SCADD) Length 254? BS XBINP BR MMENU UPKEY DCEQ >0081,@SCADD Top of screen? BS GLESS So scroll screen down DSUB 32,@SCADD Up one. BR GLESS2 Return GLESS DCEQ >2580,@PAD4 Start of buffer? BS OKKEY Yes DSUB >20,@PAD4 One more line down GLESS2 BR OKKEY DKEY CEQ >20,V@1(@SCADD) Blank line? BS UPKEY DCEQ >02C1,@SCADD Bottom of screen? BS GMORE So scroll screen up DADD 32,@SCADD Down one. BR OKKEY No GMORE DCEQ @FREPTR,@PAD4 End of buffer? BS OKKEY Yes CEQ >20,V@>00A2 Last line in buffer? BS OKKEY Yes DADD >20,@PAD4 One more line up BR OKKEY LKEY ST 18,@BUFFR Line Counter LUPKEY DCEQ >0081,@SCADD Top of screen? BS LGLESS So scroll screen down DSUB 32,@SCADD Up one. BR LGLES2 Return LGLESS DCEQ >2580,@PAD4 Start of buffer? BS LOKKEY Yes DSUB >20,@PAD4 One more line down LGLES2 BR LOKKEY LOKKEY CALL FLSCR DEC @BUFFR Line counter -1 BR LUPKEY Continue Loop B NOKEY Done. RKEY ST 18,@BUFFR Line Counter RDKEY CEQ >20,V@1(@SCADD) Blank line? BS UPKEY DCEQ >02C1,@SCADD Bottom of screen? BS RGMORE So scroll screen up DADD 32,@SCADD Down one. BR ROKKEY No RGMORE DCEQ @FREPTR,@PAD4 End of buffer? BS ROKKEY Yes CEQ >20,V@>00A2 Last line in buffer? BS ROKKEY Yes DADD >20,@PAD4 One more line up BR ROKKEY ROKKEY CALL FLSCR DEC @BUFFR Line counter -1 BR RDKEY Continue Loop B NOKEY Done. FLSCR MOVE >0260,V*PAD4,V@>0080 Fill screen ST 130,V*SCADD Left arrow ST 131,V@11(@SCADD) Right arrow RTN CLRBUF ST ENTER,V@>2257 Clear buffer MOVE 63,V@>2257,V@>2258 MOVE 63,V@>2257,V@>2402 CALL CLRFAC RTN * * PAB data * CATDAT BYTE 0,>D,8,>36,0,0,0,0,0 * HALVE BYTE >40,>02,0,0,0,0,0,0 * * Screen - prints initial screen and disk info * SCREEN FMT ROW 0 COL 2 HTEX 'Directory= Files000' ROW+ 1 COL 2 HTEX 'Free= Used=' ROW+ 1 COL 2 HTEX ' Filename Size Type P' ROW+ 1 COL 2 HTEX '---------- ---- ----------- -' FEND CLR @COUNT Clear file counter CALL DISSTR Get string into FAC CZ @FAC1 Skip if zero length BS CAT3 FMT ROW 0 COL 12 HSTR 10,@FAC2 FEND CAT3 DADD @FAC,@SCADD Go to next field DADD 19,@SCADD Continue to last field DST >28,@SCNADD Set up screen addr DCEQ >4453,V@>100A DSK? BR CAT4 No, must be HARD CALL DISNUM Display available DSK space B CAT4A CAT4 MOVE 8,V*SCADD,@ARG Get Available space *2 MOVE 8,G@HALVE,@FAC Get divisor XML ROUND CALL DISNU1 Display available HARD space * Display used space CAT4A MOVE 8,V*SCADD,@FAC Get Available space DSUB 9,@SCADD Point to formatted space MOVE 8,V*SCADD,@ARG Move it to ARG XML FSUB Develop used value *2 DST >38,@SCNADD Set up screen addr DCEQ >4453,V@>100A DSK? BS CAT4B Yes, must be DISK MOVE 8,@FAC,@ARG Get Unused space *2 MOVE 8,G@HALVE,@FAC Get divisor XML FDIV XML ROUND CAT4B CALL DISNU1 Display used space RTN Return * * Display one file on screen * FILNAM CALL DISSTR Get string into FAC INC @COUNT FILE COUNT +1 CZ @FAC1 Skip display if zero BS CAT5 length FMT Put disk name on screen ROW 23 . COL 02 . HSTR 10,@FAC2 . FEND . CAT5 DADD @FAC,@SCADD Go to next field DADD 10,@SCADD Continue another field DCZ V*SCADD Time to get out if BS FILNA1 zero file size DST >2EA,@SCNADD Set up screen address CALL DISNUM Display file length DSUB 9,@SCADD Back a field MOVE 8,V*SCADD,@FAC Move it into FAC XML CFI Convert it to an int. CZ @FAC Non-negative? BS CAT5A YES! File not protected ST @PAD2,V@>2FE Put a 'Y' on screen DNEG @FAC Make number positive CAT5A DEC @FAC1 Adjust for CASE CASE @FAC1 Show file type BR DF . BR DV . BR IF . BR IV . BR PR . BR DI DF FMT ROW 23 COL 18 HTEX 'Dis/Fix' FEND BR CAT6 DV FMT ROW 23 COL 18 HTEX 'Dis/Var' FEND BR CAT6 IF FMT ROW 23 COL 18 HTEX 'Int/Fix' FEND BR CAT6 IV FMT ROW 23 COL 18 HTEX 'Int/Var' FEND BR CAT6 PR FMT ROW 23 COL 18 HTEX 'Program' FEND BR CAT7 Return DI FMT ROW 23 COL 18 HTEX 'Directory' FEND BR CAT7 CAT6 DADD 18,@SCADD Advavce two fields DST >2F6,@SCNADD Set up screen address CALL DISNUM Display record length CAT7 MOVE >1F,V@>02E0,V@0(@FREPTR) DADD >20,@FREPTR * * Scroll the screen * SCROLL MOVE >260,V@>A0,V@>80 Scroll screen ST SPACE,V@>2E0 Clear last line MOVE >1F,V@>2E0,V@>2E1 RTN Return FILNA1 DCLR @TMPCNT Clear a byte CZ @TMPCNT Set COND bit RTNC Return w/COND * Display number subroutine * ENTER: Floating number in FAC for DISNU1 * Screen address in SCNADD * DISNUM MOVE 8,V*SCADD,@FAC Move FLP number to FAC DISNU1 CLR @FAC11 Indicate a free format CALL CNS Convert FAC to a string DST 7,@TMP Right justify number SUB @FAC12,@TMP1 DADD @TMP,@SCNADD DISNU2 ST *FAC11,V*SCNADD Put a char on the screen DINC @SCNADD Increment screen addr. INC @FAC11 Increment FAC addr. DEC @FAC12 Decrement string length count BR DISNU2 Loop until done RTN Return to caller * * Prepare a VDP string for FORMAT statement * LEAVE: FAC has string length (word) * FAC2 has string * SCADD pointing to next string in record * DISSTR DST >0836,@SCADD Get buffer address CLR @FAC Clear MSB of FAC word ST V*SCADD,@FAC1 Store disk name length DINC @SCADD Point to string ST >20,@FAC2 Clear out string space MOVE 9,@FAC2,@FAC3 . MOVE @FAC,V*SCADD,@FAC2 Move disk name into FAC RTN *********************************************************** * ERRORS *********************************************************** GE8B0 CALL EASCRN GE8B3 CALL GE8FC CHE >08,@CODE BR CHKERR SUB >08,@CODE CH >05,@CODE BS GE8D4 CALL CLSALL CASE @CODE BR GE90F BR GE908 BR GE928 BR GE92F BR GE936 BR GE93D GE8D4 CLOG >20,@FLAG BR GE767 CLOG >01,@FLAG2 BR LANDR CALL CLSPAB BR EDITOR GE8E3 CALL GE8FC CALL EASCRN CEQ >0F,@CODE BR GE8F5 CALL ERRMSG DATA ERRPNF * ERROR PROGRAM NOT FOUND BR GE949 GE8F5 CALL ERRMSG DATA ERRC BR GE029 CALL GE8FC B GE029 GE8FC MOVE 1,G@VREGS,#1 GE907 RTN GE908 CALL WRNMSG DATA CCRMSG * WARNING CONTROL CHARACTERS REMOVED BR GE8D4 GE90F CALL ERRMSG DATA ERRMF * ERROR MEMORY FULL BR GE8D4 GE916 CALL ERRMSG DATA ERRPNF * ERROR PROGRAM NOT FOUND BR OLDEA GE91D CLOG >08,@FLAG BR GE9E2 GE9E2 CALL ERRMSG DATA ERRNME * ERROR NO MEMORY EXPANSION EXIT GE928 CALL ERRMSG DATA ERRIT * ERROR ILLEGAL TAG BR LANDR GE92F CALL ERRMSG DATA ERRCE * CHECKSUM ERROR BR LANDR GE936 CALL ERRMSG DATA ERRDD * ERROR DUPLICATE DEFINITION BR LANDR GE93D CALL ERRMSG DATA ERRUR * ERROR UNRESOLVED REFERENCE BR LANDR GE944 CALL ERRMSG DATA ERRNTL * ERROR NAME TO LONG GE949 DCZ @FAC6 BS GE958 ST SPACE,V*FAC4 MOVE @FAC6,V*FAC4,V@1(@FAC4) GE958 CALL CLRMSG BR GE848 CHKERR CZ @DSKFLG * Check Search flag BS CHKER2 * Yes, normal error INC @DSKFLG * Drive # + 1 CHE 58,@DSKFLG * Last drive? BR MYSRCH * No, continue Search CHKER2 ST V@1(@PABPTR),@FAC4 AND >E0,@FAC4 SRL >05,@FAC4 OR >30,@FAC4 AND >1F,V@1(@PABPTR) CEQ >35,@FAC4 Error Read past EOF BR GE97A CALL CLSALL CEQ 1,@LDFLAG BR EDITOR EDITOR CEQ 2,@LDFLAG BR ASSEM ASSEMBLER GE97A CALL ERRMSG DATA ERRIOC * I O ERROR CODE CEQ 1,@LDFLAG BS EDITOR CEQ 2,@LDFLAG BS ASSEM GE97F CALL CLSALL CLOG >20,@FLAG BR OLDEA CLOG >01,@FLAG2 BR LANDR CLOG >08,@FLAG2 BR OLDEA BR EDITOR CLSALL CALL P1000 CALL CLSPAB DST >1100,@PABPTR CALL CLSPAB DST >1200,@PABPTR CALL CLSPAB DST >1300,@PABPTR CALL CLSPAB RTN CLSPAB DST @PABPTR,@VPAB DADD >0009,@VPAB ST >01,V*PABPTR CALL DSRLNK BYTE >08 CLR V@>0009(@PABPTR) RTN WRNMSG CALL CLRMSG MOVE 11,G@WARN,V@>02A2 BR GE9DA ERRMSG CALL CLRMSG MOVE 9,G@ERROR,V@>02A2 GE9DA FETCH @FAC FETCH @FAC1 CLR @FAC2 MOVE 1,G@0(@FAC),@FAC3 MOVE @FAC2,G@1(@FAC),V@>02C2 DCEQ ERRIOC,@FAC BR GE9F8 ST @FAC4,V@>02D2 GE9F8 DCEQ ERRC,@FAC BR WENTER DSRL >0004,@CODE SRL >04,@CODE1 CH >09,@CODE BR GEA12 CH >0F,@CODE BS WENTER ADD >07,@CODE GEA12 CH >09,@CODE1 BR GEA1F CH >0F,@CODE1 BS WENTER ADD >07,@CODE1 GEA1F DADD >3030,@CODE DST @CODE,V@>02D0 * Wait for ENTER WENTER MOVE 23,G@PRESS,V@>02E2 GEA2E SCAN BR GEA2E CEQ >0D,@KEY BR GEA2E B SETUP cHANGED FROM RETURN *************************************** CLRMSG ST SPACE,V@>02A0 MOVE >005F,V@>02A0,V@>02A1 RTN ******************************************** * INIT * BINIT2 DCEQ >A55A,@>2000 BS GEBBD BINIT3 CALL EXPMEM ST >03,@FAC CLR @>6004 * Set ROM3 XML >8A * EAINIT BR CLRXOP GEBBD RTN ******************************* CLRFAC CLR @FAC MOVE 7,@FAC,@FAC1 RTN ******************************* P1000 DST >1000,@PABPTR RTN ******************************* DEVICE CALL EXPMEM Clear expansion memory MOVE 128,V@>027F,V@>0280 ST @KEY,@PAD6 Save key FMT ROW 16 COL 2 HTEX 'Select DSK#.' FEND MOVE 5,V@>100F,V@>020E EDIT1 or ASSM1 DEV1 SCAN KEY? BR DEV1 No. CEQ SPACE,@KEY SPACE BAR? BS DEV4 Yes CEQ BACK,@KEY BACK? BS DEV3 Yes ST @KEY,V@>020C Any other key SAVE ST @KEY,V@>100D Put into PAB DEVNO ST @PAD6,@KEY Restore old key DEV2 CALL PMSG PLEASE WAIT... DEV3 RTN DEV4 FMT ROW 16 COL 2 HTEX 'Example: WDS1.EA.' ROW 18 COL 2 HTEX 'FULL PATH?' FEND MOVE 5,V@>100F,V@>0213 EDIT1 or ASSM1 DST >0282,@CURADD CLR @DSKFLG Clear search flag OR >04,@FLAG Set return flag CALL GETINP DST @CURADD,@PAD SUB >82,@PAD1 ST @PAD1,V@>1009 MOVE @PAD,V@>0282,V@>100A ST >20,@FLAG B DEVNO ********************************************************** EADSR DATA SEADSR DATA SETUP STRI 'EA' SEADSR DATA XBDSR DATA SETUP STRI 'ea' ************************************ XBDSR DATA SXBDSR DATA RXB STRI 'XB' SXBDSR DATA BASIC DATA RXB STRI 'xb' ************************************ BASIC DATA SBASIC DATA >216F STRI 'BASIC' SBASIC DATA >0000 DATA >216F STRI 'basic' *********************************************************** C1 STRI 'DSK1.EDIT1' C2 STRI 'DSK1.ASSM1' C3 STRI 'DSK1.SOURCE' C4 STRI 'DSK1.OBJECT' C5 STRI 'DSK1.LIST' C6 STRI 'L' PAB BYTE >05,>00,>13,>80,>00,>00,>21,>00 DLEN BYTE >00,>0A DDSK1 TEXT 'DSK1.' DEDIT1 TEXT 'EDIT1' DASSM1 TEXT 'ASSM1' DUTIL1 TEXT 'UTIL1' BYTE >0D DLOAD TEXT 'LOAD' BYTE >0D PAB80 BYTE >00,>12,>10,>00,>50,>00,>00,>00,>00,>00 ERROR TEXT '* ERROR *' OUTSCN TEXT '* 72 NAMES SHOWN *' PRESS TEXT 'Press ENTER to continue' WARN TEXT '* WARNING *' ERRMF STRI 'MEMORY FULL' ERRIOC STRI 'I/O ERROR CODE' ERRNME STRI 'NO MEMORY EXPANSION' ERRNTL STRI 'NAME TOO LONG' ERRC STRI 'ERROR CODE' CCRMSG STRI 'CONTROL CHARACTER REMOVED' ERRIT STRI 'ILLEGAL TAG' ERRCE STRI 'CHECKSUM ERROR' ERRDD STRI 'DUPLICATE DEFINITION' ERRUR STRI 'UNRESOLVED REFERENCE' ERRPNF STRI 'PROGRAM NOT FOUND' FPATH TEXT 'PATH.NAME?' PLEASE TEXT 'Please wait ...' WDS1 TEXT 'WDS1.' CURPAT BYTE >FF,>FF,>FF,>FF,>FF,>FF,>FF,>FF BYTE >FF,>FF,>FF,>FF,>FF,>FF,>FF,>FF DARROW DATA >0010,>18FC,>1810,>0000 * RIGHT ARROW DATA >0020,>60FC,>6020,>0000 * LEFT ARROW VREGS BYTE >E0,>00,>0E,>01,>06,>00 ********************************************************** * TI BASIC SUPPORT ROUTINES ********************************************************** BASICS DATA G6B47,G6B82 * INIT STRI 'INIT' G6B47 DATA G6B50,G6BD8 * LOAD STRI 'LOAD' G6B50 DATA G6B59,G6CF4 * LINK STRI 'LINK' G6B59 DATA G6B62,G6C6F * PEEK STRI 'PEEK' G6B62 DATA G6B6C,G6C6A * PEEKV STRI 'PEEKV' G6B6C DATA G6B76,G6BD3 * POKEV STRI 'POKEV' G6B76 DATA >0000,G6DFE * CHARPAT STRI 'CHARPAT' ********************************************************** * CALL INIT ********************************************************** G6B82 OR >08,@FLAG ==== DADD >0005,@PGMPTR token pointer CALL BINIT3 load 9900 subs BR G6DED return * skip sub name G6BBE CLR @FAC ------------- ST V*PGMPTR,@FAC1 size DADD @FAC,@PGMPTR DINC @PGMPTR e o name XML >1B next token CEQ >B7,@XTOKEN BR G6EF3 not ( incor statement XML >1B next token RTN ********************************************************** * CALL POKEV ********************************************************** G6BD3 OR >01,@FLAG ===== BR G6BDD load G6BD8 DCLR @FLAG ==== OR >08,@FLAG ********************************************************** * CALL LOAD ********************************************************** G6BDD CALL G6BBE skip sub name G6BE0 PARSE >B6 * address CEQ >65,@FAC2 BS G6C29 string: file XML >12 real->integer CEQ >03,@ERCODE BS G6F07 number too big DST @FAC,@PAD4 save adress G6BF1 CEQ >B3,@XTOKEN BR G6DE8 no , => exit XML >1B get next token PARSE >B6 * data CEQ >65,@FAC2 BR G6C05 DCZ @FAC6 string BS G6C61 empty: new addr BR G6F11 bad argument G6C05 XML >12 real->int CEQ >03,@ERCODE BS G6F07 number too big CLOG >01,@FLAG BS G6C17 ST @FAC1,V*PAD4 write to vdp BR G6C24 G6C17 DSUB PAD,@PAD4 write to cpu ST @FAC1,@PAD(@PAD4) DADD PAD,@PAD4 G6C24 DINC @PAD4 next addr B G6BF1 G6C29 DCZ @FAC6 load file BS G6C61 empty: new addr CLOG >01,@FLAG BR G6F0C string-number err DST @FAC6,@BYTES DADD >005A,@BYTES XML >17 assign var CALL BINIT2 load 9900 subs CALL GETSPACE get space XML >18 pop value from stack CALL VZERO clear 70 bytes CALL PABNAM copy file name ST >60,V@>0008(@PABPTR) screen offset ST >04,V@>0001(@PABPTR) df input DADD @PABPTR,@FAC6 DADD >000A,@FAC6 DST @FAC6,V@>0002(@PABPTR) buffer BR GE826 G6C61 CEQ >B3,@XTOKEN BR G6DE8 no , => exit XML >1B next token BR G6BE0 loop ********************************************************** * CALL PEEKV ********************************************************** G6C6A OR >01,@FLAG ===== BR G6C71 peek G6C6F DCLR @FLAG ==== ********************************************************** * CALL PEEK ********************************************************** G6C71 CALL G6BBE skip sub name G6C74 PARSE >B6 * address CEQ >65,@FAC2 BS G6C98 string XML >12 real->integer CEQ >03,@ERCODE BS G6F07 number too big DST @FAC,@PAD4 save address CEQ >B3,@XTOKEN BR G6DE8 no , => exit G6C8A XML >1B get next token CEQ >C7,@XTOKEN data BR G6CA5 PARSE >B6 * 'string' CEQ >65,@FAC2 BR G6CA5 G6C98 DCZ @FAC6 string BR G6F0C empty: err CEQ >B3,@XTOKEN BR G6DE8 no , => exit XML >1B next token BR G6C74 new address G6CA5 CHE >80,@XTOKEN BS G6DE8 instr => exit XML >13 get symbol addr XML >14 get symb value XML >17 put it on stack CLOG >01,@FLAG BS G6CBB ST V*PAD4,@ARG1 read from vdp BR G6CC8 G6CBB DSUB PAD,@PAD4 read from cpu mem ST @PAD(@PAD4),@ARG1 DADD PAD,@PAD4 G6CC8 CALL G6DF6 clear 4A-51 CZ @ARG1 BS G6CE8 =0 ST >40,@FAC exponent 0 CLR @ARG DIV >64,@ARG ST @ARG,@FAC1 div by 100 ST @ARG1,@FAC2 remainder CZ @FAC1 BR G6CE6 >100 EX @FAC1,@FAC2 result in 4C BR G6CE8 G6CE6 INC @FAC inc exponent G6CE8 XML >15 assign variable CEQ >B3,@XTOKEN BR G6DE8 no , => exit DINC @PAD4 next address B G6C8A one more ********************************************************* * CALL LINK ********************************************************* G6CF4 OR >08,@FLAG ==== CALL G6BBE skip sub name CALL EXPMEM check mem DCEQ >A55A,@>2000 BR G6EEE prog not found OR >08,@FLAG DST @VSTACK,@SCADD value stack ptr PARSE >B6 * parse program name CEQ >65,@FAC2 BR G6F0C string-number err CH >06,@FAC7 BS G6F11 size > 6 bad argum XML >17 push value on stack CLR @TMPCNT # of params DST >9D0A,@TMP >200A: list of params types G6D1F CEQ >B6,@XTOKEN BS G6DC1 char ) => start CEQ >B3,@XTOKEN BR G6EF3 incorrect statement DST @PGMPTR,@CODE char , => param XML >1B next token CHE >80,@XTOKEN BS G6D84 instruction CALL G6DF6 clear 4A-51 XML >13 get symbol addr CLOG >40,V*FAC BR G6D84 CEQ >B3,@XTOKEN BS G6D9D next token is , CEQ >B6,@XTOKEN BS G6D9D next token is ) CEQ >B7,@XTOKEN BS G6D54 next token is ( CHE >80,@XTOKEN BS G6D84 next token is an instruction BR G6EF3 incorrect statement G6D54 XML >1B get next token CEQ >B6,@XTOKEN BS G6D67 it's ) CEQ >B3,@XTOKEN BS G6D54 it's , DDEC @PGMPTR back to previous token ST >B7,@XTOKEN make it a ) BR G6D9D G6D67 XML >1B get next token CLOG >80,V*FAC BR G6D76 ST >04,@PAD(@TMP) BR G6D7B G6D76 ST >05,@PAD(@TMP) G6D7B DST @FAC,@FAC4 DADD >0006,@FAC4 BR G6DB4 G6D84 DST @CODE,@PGMPTR token pointer XML >1B next token PARSE >B6 CEQ >65,@FAC2 BR G6D97 ST >01,@PAD(@TMP) string BR G6D9B G6D97 CLR @PAD(@TMP) number G6D9B BR G6DB4 G6D9D XML >14 get symbol value *PA CHE >B8,@XTOKEN BS G6D84 token is & :loop CZ @FAC2 BR G6DAF ST >02,@PAD(@TMP) numeric variable BR G6DB4 G6DAF ST >03,@PAD(@TMP) string variable G6DB4 INC @TMPCNT CH >10,@TMPCNT max 10 param BS G6F11 bad argumemt DINC @TMP XML >17 push on stack BR G6D1F * G6DC1 ST >20,@FAC blank 4A-4E MOVE >0005,@FAC,@FAC1 MOVE >0004,V@>000C(@SCADD),@PAD address of link name in VDP mem DCZ @PAD2 BS GE88E none G6DD4 MOVE @PAD2,V*PAD,@FAC copy name to scratch-pad DST @PAD2,@FAC6 name length BR GE88E *--------------------------------------------------------- * G6DDE DCH @SCADD,@VSTACK BR G6DE8 * G6DE3 XML >18 pop from stack B G6DDE * exit G6DE8 CEQ >B6,@XTOKEN ---- BR G6EF3 no ) incor statement G6DED XML >1B next token CZ @XTOKEN BR G6EF3 incorrect statement CALL RETURN 00 ret to basic * G6DF6 CLR @FAC clear >4A-51 MOVE >0007,@FAC,@FAC1 RTN *********************************************************** * CALL CHARPAT *********************************************************** G6DFE CALL G6BBE ======= G6E01 PARSE >B6 * skip sub name CEQ >65,@FAC2 BS G6F0C string-number err XML >12 real->int CEQ >03,@ERCODE BS G6F07 number too big DCGE >0020,@FAC BR G6F11 bad arg if <32 DCGT >009F,@FAC BS G6F11 bad arg if >159 DSLL >0003,@FAC DST >0300,@SCADD DADD @FAC,@SCADD address in vdp DST >0010,@BYTES CALL GETSPACE get 16 bytes free DST @PABPTR,@TMPCNT save pointer ST >08,@PAD4 8 bytes G6E33 ST V*SCADD,@PAD DSRL >0004,@PAD first nibble ADD >30,@PAD to ascii CGT >39,@PAD BR G6E46 ADD >07,@PAD A-F G6E46 SRL >04,@PAD1 second nibble ADD >30,@PAD1 to ascii CGT >39,@PAD1 BR G6E54 ADD >07,@PAD1 A-F G6E54 DST @PAD,V*TMPCNT G6E58 DINC @SCADD next vdp byte DINCT @TMPCNT next 2 chars DEC @PAD4 BR G6E33 loop XML >1B next token CHE >80,@XTOKEN BS G6EF3 incorrect statement XML >13 get symbol addr XML >14 get symbol value XML >17 push it on stack CEQ >65,@FAC2 BR G6F0C string-number err DST >001C,@FAC string exp flag DST @PABPTR,@FAC4 vdp address DST >0010,@FAC6 size XML >15 assign var CEQ >B3,@XTOKEN BR G6DE8 no , => exit XML >1B next token BR G6E01 one more char ********************************************************** * error handling G6E88 DECT @SUBSTK -------------- CHE >08,@CODE BR G6F4D 1-7: io error CHE >0F,@CODE BS G6E97 CALL CLSPAB 8-14: close pab G6E97 CH >21,@CODE BS G6F48 >33: unknown SUB >08,@CODE CASE @CODE BR G6ED5 8 BR G6EF3 9 BR G6EDA 10 BR G6EDF 11 BR G6EE4 12 BR G6EE9 13 BR G6EF3 14 BR G6EEE 15 BR G6EF3 16 BR G6EF8 17 BR G6EFD 18 BR G6F02 19 BR G6F07 20 BR G6F0C 21 BR G6F11 22 BR G6F16 23 BR G6F1B 24 BR G6F20 25 BR G6F25 26 BR G6F2A 27 BR G6F54 28 BR G6F2F 29 BR G6F34 30 BR G6F39 31 BR G6F3E 32 BR G6ED5 33 G6ED5 CALL BERR error routine DATA >2049 * 33, 8: memory full G6EDA CALL BERR DATA G6F59 * 10: illegal tag G6EDF CALL BERR DATA G6F65 * 11: checksum error G6EE4 CALL BERR DATA G6F74 * 12: duplicate def G6EE9 CALL BERR DATA G6F89 * 13: unresolved ref G6EEE CALL BERR DATA G6F9E * 15: prog not found G6EF3 CALL BERR DATA >202C * 9,14,16: incorrect statement G6EF8 CALL BERR DATA >2040 * 17: bad name G6EFD CALL BERR DATA >2055 * 18: can't continue G6F02 CALL BERR DATA >2064 * 19: bad value G6F07 CALL BERR DATA >206E * 20: number too big G6F0C CALL BERR DATA >207D * 21: string number mismatch G6F11 CALL BERR DATA >2094 * 22: bad argument G6F16 CALL BERR DATA >20A1 * 23: bad subscript G6F1B CALL BERR DATA >20AF * 24: name conflict G6F20 CALL BERR DATA >20BD * 25: can't do that G6F25 CALL BERR DATA >20D9 * 26: bad line number G6F2A CALL BERR DATA >20F9 * 27: for-next error G6F2F CALL BERR DATA >211D * 29: file error G6F34 CALL BERR DATA >2128 * 30: input error G6F39 CALL BERR DATA >2134 * 31: data error G6F3E CALL BERR DATA >213F * 32: line too long G6F43 CALL BERR DATA G6FB0 * no mem expansion (called by G6922) G6F48 CALL BERR DATA G6FC4 * 33+: unknown err G6F4D DST @PABPTR,@PAD4 DSUB >0004,@PAD4 G6F54 CALL BERR DATA >2113 * 1-7,28: i/o error * G6F59 BYTE >0B,>A9,>AC,>AC,>A5,>A7,>A1,>AC BYTE >80,>B4,>A1,>A7 * 'CHECKSUM ERROR' G6F65 BYTE >0E,>A3,>AB,>A5,>A3,>AB,>B3,>B5 BYTE >AD,>80,>A5,>B2,>B2,>AF,>B2 * 'DUPLICATE DEFINITION' G6F74 BYTE >14,>A4,>B5,>B0,>AC,>A9,>A3,>A1 BYTE >B4,>A5,>80,>A4,>A5,>A6,>A9,>AE BYTE >A9,>B4,>A9,>AF,>AE * 'UNRESOLVED REFERENCE' G6F89 BYTE >14,>B5,>AE,>B2,>A5,>B3,>AF,>AC BYTE >B6,>A5,>A4,>80,>B2,>A5,>A6,>A5 BYTE >B2,>A5,>AE,>A3,>A5 * 'PROGRAM NOT FOUND' G6F9E BYTE >11,>B0,>B2,>AF,>A7,>B2,>A1,>AD BYTE >80,>AE,>AF,>B4,>80,>A6,>AF,>B5 BYTE >AE,>A4 * 'NO MEMORY EXPANSION' G6FB0 BYTE >13,>AE,>AF,>80,>AD,>A5,>AD,>AF BYTE >B2,>B9,>80,>A5,>B8,>B0,>A1,>AE BYTE >B3,>A9,>AF,>AE * 'UNKNOWN ERROR CODE' G6FC4 BYTE >12,>B5,>AE,>AB,>AE,>AF,>B7,>AE BYTE >80,>A5,>B2,>B2,>AF,>B2,>80,>A3 BYTE >AF,>A4,>A5 *--------------------------------------------------------- * load (c) def G6FD7 CALL EXPMEM ------------ MOVE >0008,G@G6FE2,V@>0850 RTN G6FE2 DATA >3C42,>99A1,>A199,>423C * G6FEA DATA 0,0,0,0,0,0,0,0,0,0,0 * up to G6FFF ************************************************************ AORG >1FF0 RXBCAT B DIRECT ************************************************************ END