home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / archives / k65src.zip / kermit65.m65 next >
Text File  |  1990-05-27  |  411KB  |  15,024 lines
  1. ; TITLE  KERMIT-65    KL10 Error-free Reciprocal Micro-interface Transfer
  2. ;
  3. ;    6502 version - Antonino N. J. Mione
  4. ;    Commodore 64 version converted from Apple version 1.1
  5. ;    By Dave Dermott  March, 1984
  6. ;    Additional improvements by Eric Lavitsky/Frank Prindle/
  7. ;    Michael Marchiondo/Ray Moody
  8. ;
  9. ;    Atari 800 version converted from Commodore version by 
  10. ;    John Dunning.
  11. ;
  12. ;    Version 3.7 
  13. ;
  14. ;.SBTTL    Revision History
  15.  
  16. ;
  17. ; Date        Description
  18. ; ------    -----------
  19. ; 4/87 - 7/87    By JRD.  Found the Commodore version and went at it with 
  20. ;        a meat cleaver.  Made changes too numerous to detail here;
  21. ;        replaced all io with calls to CIO; revamped screen handling
  22. ;        to use CTIA instead of VIC, cleaned up user interface, fixed
  23. ;        comm port handling to work with 850, ad nauseum.
  24. ;
  25. ; ------    v3.1 released here
  26. ;
  27. ; 8/10/87 - 8/17/87
  28. ;        Fixed binary mode.  Fixed eight-bit-quoting negotiation.
  29. ;        Make erase and rename ensure rs port closed.  Fix stupid
  30. ;        but insidious bug in terminal code that caused graphics
  31. ;        mode to be turned on spuriously when processing a BS
  32. ;        in column 15 (!)
  33. ;
  34. ; ------    v 3.2 released here
  35. ;
  36. ; 8/18/87 - 
  37. ;        Finish wildcard support in pathnames.  Fix file reader
  38. ;        to deal with Spartados not adhering to spec.  Fix all
  39. ;        parameter display/entry to use decimal where apropriate,
  40. ;        ie in timeout values.  Display values in 'Status' display
  41. ;        in decimal.  Implement Atari key (/|\) as input-suspend.
  42. ;        Fix bug in flow-control that caused it to wedge up
  43. ;        unexpectedly.  Clean up 80-column font per JHS's comments.
  44. ;        Removed Speedscript file type.  Fix stack-corruption
  45. ;        in terminal code.  Clean up some of the really obscure
  46. ;        cases in vt100 mode.
  47. ;        
  48. ; 4/11/90 - jrd
  49. ;        Fix bug in Spartados EOF handling.  Remove assumption
  50. ;        about screen width, to allow XEP80 to work.
  51. ;
  52. ; release v 3.6.
  53. ;
  54. ; 5/28/90 - jrd
  55. ;        Fix the stupid D8: bug again.
  56. ;
  57. ; release v 3.7.
  58. ;
  59. ;
  60. ;----------------------------------------------------------------
  61. ;
  62. ; Things that need doing:
  63. ;
  64. ; The telnet loop is a real mess, needs to be flushed and redone completely.
  65. ;
  66. ; Rip out old debugging code.
  67. ;
  68. ; Parameterize Serial io calls so that we can run smoother with interfaces 
  69. ; other than 850
  70. ;
  71. ; Finish making all the internal pathname hacking stuff really use 
  72. ; pathnames, not just strings.
  73. ;
  74. ; Implement 'Remote ... ' command.
  75. ;
  76. ; Implement some facility for defining function keys.
  77. ;
  78. ;+
  79.  
  80. ;
  81. ;----------------------------------------------------------------
  82. ;
  83. ; Defs for running this thing on an atari
  84. ;
  85. kbdchan    =    $10        ; keyboard IOCB
  86. scrchan =    $00        ; screen (E:) IOCB
  87. comchan =    $30        ; serial port
  88. dskchan =    $40        ; disk
  89. dirchan =    $50        ; special one for directory access
  90. ;
  91. ;.SBTTL    Jump to start of code
  92.  
  93. ;kst:    jmp    kstart        ; Go past the data to the beginning of the code
  94. ; on atari, just say where to start
  95.     *=    $2E0
  96.     .word    kstart
  97.  
  98. ;
  99. ;    now start at a reasonable place
  100. ;
  101.     *=    $2D20        ; about as low as reasonable on atari
  102. ;
  103. ;.SBTTL    Character and string definitions
  104. ; 
  105. nul    =    $00        ; <null>
  106. soh    =    $01        ; <soh>
  107. bel    =    $07        ; c-g
  108. bs    =    $08        ; <bs>
  109. tab    =    $09        ; <tab> (ctrl/I)
  110. lf    =    $0A        ; <lf>
  111. ffd    =    $0C        ; Form feed
  112. cr    =    $0D        ; <cr>
  113. so    =    $0E        ; <shift-out>
  114. si    =    $0F        ; <shift-in>
  115. ctrlu    =    $15        ; <ctrl/U>
  116. ctrlx    =    $18        ; <ctrl/X>
  117. ctrly    =    $19        ; <ctrl/Y>
  118. esc    =    $1B        ; <esc>
  119. sp    =    $20        ; <space>
  120. space    =    $20        ; " "
  121. del    =    $7F        ; <del>
  122. quest    =    $3F        ; <?>
  123. ctrlw    =    $17        ; <ctrl/W>
  124. dquot    =    $22        ; '"'        ?
  125. quot    =    $27        ; "'"        ?
  126. slash    =    $2F        ; '/'        ?
  127. apos    =    quot        ; "'"        ?
  128. rabr    =    $3E        ; '>'        ?
  129. colon    =    $3A        ; ':'        ?
  130.  
  131. ;----------------------------------------------------------------
  132. ; Atari OS defs from SYSMAC.SML inserted here
  133. ;
  134.  
  135. ;    VECTOR TABLE
  136.  
  137. EDITRV    =$E400            ;EDITOR
  138. SCRENV    =$E410            ;TELEVISION SCREEN
  139. KEYBDV    =$E420            ;KEYBOARD
  140. PRINTV    =$E430            ;PRINTER
  141. CASETV    =$E440            ;CASSETTE
  142.  
  143. ;    JUMP VECTOR TABLE
  144.  
  145. DISKIV    =$E450            ;DISK INITIALIZATION
  146. DSKINV    =$E453            ;DISK INTERFACE
  147. CIOV    =$E456            ;CIO ROUTINE
  148. SIOV    =$E459            ;SIO ROUTINE
  149. SETVBV    =$E45C            ;SET VERTICAL BLANK VECTORS
  150. SYSVBV    =$E45F            ;SYSTEM VERTICAL BLANK ROUTINE
  151. XITVBV    =$E462            ;EXIT VERTICAL BLANK ROUTINE
  152. SIOINV    =$E465            ;SIO INIT
  153. SENDEV    =$E468            ;SEND ENABLE ROUTINE
  154. INTINV    =$E46B            ;INTERRUPT HANDLER INIT
  155. CIOINV    =$E46E            ;CIO INIT
  156. BLKBDV    =$E471            ;BLACKBOARD MODE
  157. WARMSV    =$E474            ;WARM START ENTRY POINT
  158. COLDSV    =$E477            ;COLD START ENTRY POINT
  159. RBLOKV    =$E47D            ;CASSETTE READ BLOCK VECTOR
  160. DSOPIV    =$E480            ;CASSETTE OPEN FOR INPUT VECTOR
  161.  
  162. ;    SOME USEFUL INTERNAL ROUTINES
  163.  
  164. ;KGETCH    =$F6E2            ;GET CHAR FROM KEYBOARD only on 800
  165. EOUTCH    =$F6A4            ;OUTPUT CHAR TO SCREEN
  166. PUTLIN    =$F385            ;OUTPUT LINE TO IOCB#0
  167.  
  168. ;    COMMAND CODES FOR IOCB
  169.  
  170. OPEN    =$03            ;OPEN FOR INPUT/OUTPUT
  171. GETREC    =$05            ;GET RECORD (TEXT)
  172. GETCHR    =$07            ;GET CHARACTER(S)
  173. PUTREC    =$09            ;PUT RECORD (TEXT)
  174. PUTCHR    =$0B            ;PUT CHARACTER(S)
  175. CLOSE    =$0C            ;CLOSE DEVICE
  176. STATIS    =$0D            ;STATUS REQUEST
  177. SPECIL    =$0E            ;SPECIAL ENTRY COMMANDS
  178.  
  179. ;    SPECIAL ENTRY COMMANDS
  180.  
  181. DRAWLN    =$11            ;DRAW LINE
  182. FILLIN    =$12            ;DRAW LINE WITH RIGHT FILL
  183. RENAME    =$20            ;RENAME DISK FILE
  184. DELETE    =$21            ;DELETE DISK FILE
  185. FORMAT    =$22            ;FORMAT DISK
  186. LOCKFL    =$23            ;LOCK FILE (READ ONLY)
  187. UNLOCK    =$24            ;UNLOCK FILE
  188. POINT    =$25            ;POINT SECTOR
  189. NOTE    =$26            ;NOTE SECTOR
  190.  
  191. CCIO    =$28            ;CONCURRENT I/O MODE
  192.  
  193. IOCFRE    =$FF            ;IOCB "FREE"
  194.  
  195. ;    AUX1 VALUES FOR OPEN
  196.  
  197. APPEND    =$01            ;OPEN FOR APPEND
  198. DIRECT    =$02            ;OPEN FOR DIRECTORY ACCESS
  199. OPNIN    =$04            ;OPEN FOR INPUT
  200. OPNOT    =$08            ;OPEN FOR OUTPUT
  201. OPNINO    =OPNIN!OPNOT        ;OPEN FOR INPUT/OUTPUT
  202. MXDMOD    =$10            ;OPEN FOR MIXED MODE
  203. INSCLR    =$20            ;OPEN WITHOUT CLEARING SCREEN
  204.  
  205. ; OS STATUS CODES
  206.  
  207. SUCCES    =$01            ;SUCCESSFUL OPERATION
  208. BRKABT    =$80            ;(128) BREAK KEY ABORT
  209. PRVOPN    =$81            ;(129) IOCB ALREADY OPEN
  210. NONDEV    =$82            ;(130) NON-EX DEVICE
  211. WRONLY    =$83            ;(131) IOCB OPENED FOR WRITE ONLY
  212. NVALID    =$84            ;(132) INVALID COMMAND
  213. NOTOPN    =$85            ;(133) DEVICE OR FILE NOT OPEN
  214. BADIOC    =$86            ;(134) INVALID IOCB NUMBER
  215. RDONLY    =$87            ;(135) IOCB OPENED FOR READ ONLY
  216. EOFERR    =$88            ;(136) END OF FILE
  217. TRNRCD    =$89            ;(137) TRUNCATED RECORD
  218. TIMOUT    =$8A            ;(138) DEVICE TIMEOUT
  219. DNACK    =$8B            ;(139) DEVICE DOES NOT ACK COMMAND
  220. FRMERR    =$8C            ;(140) SERIAL BUS FRAMING ERROR
  221. CRSROR    =$8D            ;(141) CURSOR OUT OF RANGE
  222. OVRRUN    =$8E            ;(142) SERIAL BUS DATA OVERRUN
  223. CHKERR    =$8F            ;(143) SERIAL BUS CHECKSUM ERROR
  224. DERROR    =$90            ;(144) DEVICE ERROR (OPERATION INCOMPLETE)
  225. BADMOD    =$91            ;(145) BAD SCREEN MODE NUMBER
  226. FNCNOT    =$92            ;(146) FUNCTION NOT IN HANDLER
  227. SCRMEM    =$93            ;(147) INSUFFICIENT MEMORY FOR SCREEN MODE
  228.  
  229. ;    PAGE 0 LOCATIONS
  230.  
  231. LINZBS    =$00            ;LINBUG STORAGE
  232.  
  233. ;  THESE LOCS ARE NOT CLEARED
  234.  
  235. CASINI    =$02            ;CASSETTE INIT LOC
  236. RAMLO    =$04            ;RAM POINTER FOR MEM TEST
  237. TRAMSZ    =$06            ;TEMP LOC FOR RAM SIZE
  238. TSTDAT    =$07            ;RAM TEST DATA LOC
  239.  
  240. ;  CLEARED ON COLDSTART ONLY
  241.  
  242. WARMST    =$08            ;WARM START FLAG
  243. BOOTQ    =$09            ;SUCCESSFUL BOOT FLAG
  244. DOSVEC    =$0A            ;DOS START VECTOR
  245. DOSINI    =$0C            ;DOS INIT ADDRESS
  246. APPMHI    =$0E            ;APPLICATION MEM HI LIMIT
  247.  
  248. ;  CLEARED ON COLD OR WARM START
  249.  
  250. INTZBS    =$10            ; START OF OS RAM CLEAR LOC => $7F
  251. POKMSK    =$10            ;SYSTEM MASK FOR POKEY IRQ ENABLE
  252. BRKKEY    =$11            ;BREAK KEY FLAG
  253. RTCLOK    =$12            ;REAL TIME CLOCK (60HZ OR 16.66666 MS)
  254.                 ; 3 bytes; hi order, medium, low
  255. BUFADR    =$15            ;INDIRECT BUFFER ADDRESS REG
  256. ICCOMT    =$17            ;COMMAND FOR VECTOR HANDLER
  257. DSKFMS    =$18            ;DISK FILE MANAGER POINTER
  258. DSKUTL    =$1A            ;DISK UTILITIES POINTER
  259. PTIMOT    =$1C            ;PRINTER TIME OUT REGISTER
  260. PBPNT    =$1D            ;PRINT BUFFER POINTER
  261. PBUFSZ    =$1E            ;PRINT BUFFER SIZE
  262. PTEMP    =$1F            ;TEMP REG
  263. ZIOCB    =$20            ;PAGE 0 I/O CONTROL BLOCK
  264. IOCBSZ    =16            ;NUMBER OF BYTES / IOCB
  265. MAXIOC    =8*IOCBSZ        ;LENGTH OF IOCB AREA
  266. IOCBAS    =ZIOCB
  267.  
  268. ICHIDZ    =$20            ;HANDLER INDEX NUMBER ($FF := IOCB FREE)
  269. ICDNOZ    =$21            ;DEVICE NUMBER (DRIVE NUMBER)
  270. ICCOMZ    =$22            ;COMMAND CODE
  271. ICSTAZ    =$23            ;STATUS OF LAST IOCB ACTION
  272. ICBALZ    =$24            ;BUFFER ADDRESS (LOW)
  273. ICBAHZ    =$25            ;  "       "    (HIGH)
  274. ICPTLZ    =$26            ;PUT BYTE ROUTINE ADDRESS - 1
  275. ICPTHZ    =$27
  276. ICBLLZ    =$28            ;BUFFER LENGTH (LOW)
  277. ICBLHZ    =$29            ;  "       "   (HIGH)
  278. ICAX1Z    =$2A            ;AUX INFO
  279. ICAX2Z    =$2B
  280. ICSPRZ    =$2C            ;SPARE BYTES (CIO LOCAL USE)
  281. ICIDNO    =ICSPRZ+2        ;IOCB LUMBER * 16
  282. CIOCHR    =ICSPRZ+3        ;CHARACTER BYTE FOR CURRENT OPERATION
  283.  
  284. STATUS    =$30            ;INTERNAL STATUS STORAGE
  285. CHKSUM    =$31            ;CHECKSUM (SINGLE BYTE SUM WITH CARRY)
  286. BUNRLO    =$32            ;POINTER TO DATA BUFFER (LO BYTE)
  287. BUFRHI    =$33            ;POINTER TO DATA BUFFER (HI BYTE)
  288. BFENLO    =$34            ;NEXT BYTE PAST END OF BUFFER (LO BYTE)
  289. BNENHI    =$35            ;NEXT BYTE PAST END OF BUFFER (HI BYTE)
  290. CRETRY    =$36            ;NUMBER OF COMMAND FRAM RETRIES
  291. DRETRY    =$39            ;NUMBER OF DEVICE RETRIES
  292. BUFRFL    =$38            ;DATA BUFFER FULL FLAG
  293. RECVDN    =$39            ;RECEIVE DONE FLAG
  294. XMTDON    =$3A            ;XMIT DONE FLAG
  295. CHKSNT    =$3B            ;CHECKSUM SENT FLAG
  296. NOCKSM    =$3C            ;NO CHECKSUM FOLLOWS DATA FLAG
  297.  
  298. BPTR    =$3D            ;BUFFER POINTER (CASSETTE)
  299. FTYPE    =$3E            ;FILE TYPE (SHORT IRG/LONG IRG)
  300. FEOF    =$3F            ;END OF FILE FLAG (CASSETTE)
  301. FREQ    =$40            ;FREQ COUNTER FOR CONSOLE SPEAKER
  302. SOUNDR    =$41            ;NOISY I/O FLAG. (ZERO IS QUIET)
  303. CRITIC    =$42            ;CRITICAL CODE IF NON-ZERO)
  304.  
  305. FMSZPG    =$43            ;DISK FILE MANAGER SYSTEM STORAGE (7 BYTES)
  306.  
  307. CKEY    =$4A            ;SET WHEN GAME START PRESSED
  308. CASSBT    =$4B            ;CASSETTE BOOT FLAG
  309. DSTAT    =$4C            ;DISPLAY STATUS
  310. ATRACT    =$4D            ;ATTRACT MODE FLAG
  311. DRKMSK    =$4E            ;DARK ATTRACT MASK
  312. COLRSH    =$4F            ;ATTRACT COLOR SHIFTER (XOR'D WITH PLAYFIELD)
  313.  
  314. TMPCHR    =$50            ;TEMP CHAR STORAGE (DISPLAY HANDLER)
  315. HOLD1    =$51            ;TEMP STG (DISPLAY HANDLER)
  316. LMARGN    =$52            ;LEFT MARGIN
  317. RMARGN    =$53            ;RIGHT MARGIN
  318. ROWCRS    =$54            ;CURSOR COUNTERS
  319. COLCRS    =$55
  320. DINDEX    =$57            ;DISPLAY INDEX (VARIOUS QUANTS)
  321. SAVMSC    =$58
  322. OLDROW    =$5A            ;PREVIOUS ROW/COL
  323. OLDCOL    =$5B
  324. OLDCHR    =$5D            ;DATA UNDER CURSOR
  325. OLDADR    =$5E
  326. NEWROW    =$60            ;POINT DRAWS TO HERE
  327. NEWCOL    =$61
  328. LOGCOL    =$63            ;POINTS AT COLUMN IN LOGICAL LINE
  329. ADRESS    =$64            ;INDIRECT POINTER
  330. MLTTMP    =$66            ;MULTIPLY TEMP
  331. OPNTMP    =MLTTMP            ;FIRST BYTE IS USED IN OPEN AS TEMP
  332. SAVADR    =$68
  333. RAMTOP    =$6A            ;RAM SIZE DEFINED BY POWER ON LOGIC
  334. BUFCNT    =$6B            ;BUFFER COUNT
  335. BUFSTR    =$6C            ;EDITOR GETCH POINTER
  336. BITMSK    =$6E            ;BIT MASK
  337. SHFAMT    =$6F            ;OUTCHR SHIFT
  338.  
  339. ROWAC    =$70            ;USED BY "DRAW"
  340. COLAC    =$72
  341. ENDPT    =$74
  342. DELTAR    =$76
  343. DELTAC    =$77
  344. ROWINC    =$79
  345. COLINC    =$7A
  346. SWPFLG    =$7B            ;NON-0 IF TXT AND RAM SWAPPED
  347. HOLDCH    =$7C            ;CH BEFORE CNTL & SHFT PROCESSING IN KGETCH
  348. INSDAT    =$7D            ;INSERT CHAR SAVE
  349. COUNTR    =$7E            ;DRAW COUNTER
  350.  
  351. ;;;    $80 TO $FF ARE RESERVED FOR USER APPLICATIONS
  352.  
  353. ;    PAGE 2 LOCATIONS
  354.  
  355. INTABS    =$200            ;INTERRUPT TABLE
  356. VDSLST    =$200            ;DISPLAY LIST NMI VECTOR
  357. VPRCED    =$202            ;PROCEED LINE IRQ VECTOR
  358. VINTER    =$204            ;INTERRUPT LINE IRQ VECTOR
  359. VBREAK    =$206            ;"BRK" VECTOR
  360. VKEYBD    =$208            ;POKEY KEYBOARD IRQ VECTOR
  361. VSERIN    =$20A            ;POKEY SERIAL INPUT READY
  362. VSEROR    =$20C            ;POKEY SERIAL OUTPUT READY
  363. VSEROC    =$20E            ;POKEY SERIAL OUTPUT DONE
  364. VTIMR1    =$210            ;POKEY TIMER 1 IRQ
  365. VTIMR2    =$212            ;POKEY TIMER 2 IRQ
  366. VTIMR4    =$214            ;POKEY TIMER 4 IRQ (DO NOT USE)
  367. VIMIRQ    =$216            ;IMMEDIATE IRQ VECTOR
  368. CDTMV1    =$218            ;COUNT DOWN TIMER 1
  369. CDTMV2    =$21A            ;COUNT DOWN TIMER 2
  370. CDTMV3    =$21C            ;COUNT DOWN TIMER 3
  371. CDTMV4    =$21E            ;COUNT DOWN TIMER 4
  372. CDTMV5    =$220            ;COUNT DOWN TIMER 5
  373. VVBLKI    =$222            ;IMMEDIATE VERTICAL BLANK NMI VECTOR
  374. VVBLKD    =$224            ;DEFERRED VERTICAL BLANK NMI VECTOR
  375. CDTMA1    =$226            ;COUNT DOWN TIMER 1 JSR ADDRESS
  376. CDTMA2    =$228            ;COUNT DOWN TIMER 2 JSR ADDRESS
  377. CDTMF3    =$22A            ;COUNT DOWN TIMER 3 FLAG
  378. SRTIMR    =$22B            ;SOFTWARE REPEAT TIMER
  379. CDTMF4    =$22C            ;COUNT DOWN TIMER 4 FLAG
  380. INTEMP    =$22D            ;IAN'S TEMP (???)
  381. CDTMF5    =$22E            ;COUNT DOWN TIMER 5 FLAG
  382. SDMCTL    =$22F            ;SAVE DMACTL REGISTER
  383. DMACTL    =$D400            ; the real DMA control reg
  384. SDLSTL    =$230            ;SAVE DISPLAY LIST (LOW)
  385. SDLSTH    =$231            ;SAVE DISPLAY LIST (HIGH)
  386. SSKCTL    =$232            ;SKCTL REGISTER RAM
  387.  
  388. LPENH    =$234            ;LIGHT PEN HORIZ VALUE
  389. LPENV    =$235            ;LIGHT PEN VERT VALUE
  390.                 ; ($236 - $239 SPARE)
  391. CDEVIC    =$23A            ;COMMAND FRAME BUFFER - DEVICE
  392. CCOMND    =$23B            ;COMMAND
  393. CAUX1    =$23C            ;COMMAND AUX BYTE 1
  394. CAUX2    =$23D            ;COMMAND AUX BYTE 2
  395. TEMP    =$23E            ;YES
  396. ERRFLG    =$23F            ;ERROR FLAG - ANY DEVICE ERROR EXCEPT TIMEOUT
  397.  
  398. DFLAGS    =$240            ;DISK FLAGS FROM SECTOR ONE
  399. DBSECT    =$241            ;NUMBER OF DISK BOOT SECTORS
  400. BOOTAD    =$242            ;ADDRESS FOR DISK BOOT LOADER
  401. COLDST    =$244            ;COLDSTART FLAG (1 = DOING COLDSTART)
  402.                 ;($245 SPARE)
  403. DSKTIM    =$246            ;DISK TIME OUT REG
  404. LINBUF    =$247            ;CHAR LINE BUFFER (40 BYTES)
  405.  
  406. GPRIOR    =$26F            ;GLOBAL PRIORITY CELL
  407. PADDL0    =$270            ;POT 0 SHADOW
  408. PADDL1    =$271            ;POT 1 SHADOW
  409. PADDL2    =$272            ;POT 2 SHADOW
  410. PADDL3    =$273            ;POT 3 SHADOW
  411. PADDL4    =$274            ;POT 4 SHADOW
  412. PADDL5    =$275            ;POT 5 SHADOW
  413. PADDL6    =$276            ;POT 6 SHADOW
  414. PADDL7    =$277            ;POT 7 SHADOW
  415. STICK0    =$278            ;JOYSTICK 0 SHADOW
  416. STICK1    =$279            ;JOYSTICK 1 SHADOW
  417. STICK2    =$27A            ;JOYSTICK 2 SHADOW
  418. STICK3    =$27B            ;JOYSTICK 3 SHADOW
  419. PTRIG0    =$27C            ;PADDLE 0 TRIGGER
  420. PTRIG1    =$27D            ;PADDLE 1 TRIGGER
  421. PTRIG2    =$27E            ;PADDLE 2 TRIGGER
  422. PTRIG3    =$27F            ;PADDLE 3 TRIGGER
  423. PTRIG4    =$280            ;PADDLE 4 TRIGGER
  424. PTRIG5    =$281            ;PADDLE 5 TRIGGER
  425. PTRIG6    =$282            ;PADDLE 6 TRIGGER
  426. PTRIG7    =$283            ;PADDLE 7 TRIGGER
  427. STRIG0    =$284            ;JOYSTICK 0 TRIGGER
  428. STRIG1    =$285            ;JOYSTICK 1 TRIGGER
  429. STRIG2    =$286            ;JOYSTICK 2 TRIGGER
  430. STRIG3    =$287            ;JOYSTICK 3 TRIGGER
  431.  
  432. CSTAT    =$288            ;(UNUSED)
  433. WMODE    =$289            ;R/W FLAG FOR CASSETTE
  434. BLIM    =$28A            ;BUFFER LIMIT (CASSETTE)
  435.                 ;($28B - $28F SPARE)
  436. TXTROW    =$290            ;TEXT ROWCRS
  437. TXTCOL    =$291            ;TEXT ROWCOL
  438. TINDEX    =$293            ;TEXT INDEX
  439. TXTMSC    =$294            ;FOOLS CONVRT INTO NEW MSC
  440. TXTOLD    =$296            ;OLDROW & OLDCOL FOR TEXT (AND THEN SOME)
  441. TMPX1    =$29C
  442. HOLD3    =$29D
  443. SUBTMP    =$29E
  444. HOLD2    =$29F
  445. DMASK    =$2A0
  446. TMPLBT    =$2A1
  447. ESCFLG    =$2A2            ;ESCAPE FLAG
  448. TABMAP    =$2A3            ;TAB BUFFER
  449. LOGMAP    =$2B2            ;LOGICAL LINE START BIT MAP
  450. INVFLG    =$2B6            ;INVERSE VIDEO FLAG (ATARI KEY)
  451. FILFLG    =$2B7            ;RIGHT FILL FLAG FOR DRAW
  452. TMPROW    =$2B8
  453. TMPCOL    =$2B9
  454. SCRFLG    =$2BB            ;SET IF SCROLL OCCURS
  455. HOLD4    =$2BC            ;MORE DRAW TEMPS
  456. HOLD5    =$2BD
  457. SHFLOK    =$2BE            ;SHIFT LOCK KEY
  458. BOTSCR    =$2BF            ;BOTTOM OF SCREEN (24 NORM, 4 SPLIT)
  459.  
  460. PCOLR0    =$2C0            ;P0 COLOR
  461. PCOLR1    =$2C1            ;P1 COLOR
  462. PCOLR2    =$2C2            ;P2 COLOR
  463. PCOLR3    =$2C3            ;P3 COLOR
  464. COLOR0    =$2C4            ;COLOR 0
  465. COLOR1    =$2C5
  466. COLOR2    =$2C6
  467. COLOR3    =$2C7
  468. COLOR4    =$2C8            ;BACKGROUND
  469.                 ;($2C9 - $2DF SPARE)
  470. GLBABS    =$2E0            ;GLOBAL VARIABLES
  471.                 ;($2E0 - $2E3 SPARE)
  472. RAMSIZ    =$2E4            ;RAM SIZE (HI BYTE ONLY)
  473. MEMTOP    =$2E5            ;TOP OF AVAILABLE MEMORY
  474. MEMLO    =$2E7            ;BOTTOM OF AVAILABLE MEMORY
  475.                 ;($2E9 SPARE)
  476. DVSTAT    =$2EA            ;STATUS BUFFER
  477. CBAUDL    =$2EE            ;CASSETTE BAUD RATE (LO BYTE)
  478. CBAUDH    =$2EF            ;   "      "    "   (HI BYTE)
  479. CRSINH    =$2F0            ;CURSOR INHIBIT (00 = CURSOR ON)
  480. KEYDEL    =$2F1            ;KEY DELAY
  481. CH1    =$2F2
  482. CHACT    =$2F3            ;CHACTL REGISTER (SHADOW)
  483. CHBAS    =$2F4            ;CHBAS REGISTER (SHADOW)
  484.                 ;($2F5 - $2F9 SPARE)
  485. CHAR    =$2FA
  486. ATACHR    =$2FB            ;ATASCII CHARACTER
  487. CH    =$2FC            ;GLOBAL VARIABLE FOR KEYBOARD
  488. FILDAT    =$2FD            ;RIGHT FILL DATA (DRAW)
  489. DSPFLG    =$2FE            ;DISPLAY FLAG: DISP CONTROLS IF NON-ZERO
  490. SSFLAG    =$2FF            ;START/STOP FLAG (CNTL-1) FOR PAGING
  491.  
  492. ;    PAGE 3 LOCATIONS
  493.  
  494. DCB    =$300            ;DEVICE CONTROL BLOCK
  495. DDEVIC    =$300            ;BUS I.D. NUMBER
  496. DUNIT    =$301            ;UNIT NUMBER
  497. DCOMND    =$302            ;BUS COMMAND
  498. DSTATS    =$303            ;COMMAND TYPE/STATUS RETURN
  499. DBUFLO    =$304            ;DATA BUFFER POINTER
  500. DBUFHI    =$305            ; ...
  501. DTIMLO    =$306            ;DEVICE TIME OUT IN 1 SEC. UNITS
  502. DUNUSE    =$307            ;UNUSED
  503. DBYTLO    =$308            ;BYTE COUNT
  504. DBYTHI    =$309            ; ...
  505. DAUX1    =$30A            ;COMMAND AUXILLARY BYTES
  506. DAUX2    =$30B            ; ...
  507.  
  508. TIMER1    =$30C            ;INITIAL TIMER VALUE
  509. ADDCOR    =$30E            ;ADDITION CORRECTION
  510. CASFLG    =$30F            ;CASSETTE MODE WHEN SET
  511. TIMER2    =$310            ;FINAL TIME VALUE (USED TO COMPUTE BAUD RATE)
  512. TEMP1    =$312            ;TEMP LOCATIONS
  513. TEMP2    =$314            ; ...
  514. TEMP3    =$315            ; ...
  515. SAVIO    =$316            ;SAVE SERIAL IN DATA PORT
  516. TIMFLG    =$317            ;TIME OUT FLAG FOR BAUD RATE CORRECTION
  517. STACKP    =$318            ;SIO STACK POINTER SAVE LOC
  518. TSTAT    =$319            ;TEMP STATUS LOC
  519.  
  520. HATABS    =$31A            ;HANDLER ADDRESS TABLE 
  521. MAXDEV    =$21            ;MAXIMUM HANDLER ADDRESS INDEX
  522.  
  523. ;    IOCB OFFSETS 
  524.  
  525. IOCB    =$340            ;I/O CONTROL BLOCKS
  526. ICHID    =$340            ;HANDLER INDEX ($FF = FREE)
  527. ICDNO    =$341            ;DEVICE NUMBER (DRIVE NUMBER)
  528. ICCOM    =$342            ;COMMAND CODE
  529. ICSTA    =$343            ;STATUS
  530. ICBAL    =$344            ;BUFFER ADDRESS
  531. ICBAH    =$345            ; ...
  532. ICPTL    =$346            ;PUT BYTE ROUTINE ADDRESS - 1
  533. ICPTH    =$347            ; ...
  534. ICBLL    =$348            ;BUFFER LENGTH
  535. ICBLH    =$349            ; ...
  536. ICAX1    =$34A            ;AUXILLARY INFO
  537. ICAX2    =$34B            ; ...
  538. ICSPR    =$34C            ;4 SPARE BYTES
  539.  
  540. PRNBUF    =$3C0            ;PRINTER BUFFER
  541.                 ;($3EA - $3FC SPARE)
  542.  
  543. ;    PAGE 4 LOCATIONS
  544.  
  545. CASBUF    =$3FD            ;CASSETTE BUFFER
  546.  
  547. ; USER AREA STARTS HERE AND GOES TO THE END OF PAGE 5
  548.  
  549. USAREA    =$480
  550.  
  551. ;
  552. ; Other random stuff
  553. ;
  554. CONSOL    =    $D01F        ; console switches start, select, option
  555. ;ATASCII CHARACTER DEFS
  556.  
  557. ATCLR    =$7D            ;CLEAR SCREEN CHARACTER
  558. ATRUB    =$7E            ;BACK SPACE (RUBOUT)
  559. ATTAB    =$7F            ;TAB
  560. ATEOL    =$9B            ;END-OF-LINE
  561. ATDELL    =$9C            ; Delete line
  562. ATBEL    =$FD            ;CONSOLE BELL
  563. ATURW    =$1C            ;UP-ARROW
  564. ATDRW    =$1D            ;DOWN-ARROW
  565. ATLRW    =$1E            ;LEFT-ARROW
  566. ATRRW    =$1F            ;RIGHT-ARROW
  567.  
  568. ; USEFUL VALUES
  569.  
  570. LEDGE    =2            ;LMARGN'S INITIAL VALUE
  571. REDGE    =39            ;RMARGN'S INITIAL VALUE
  572.  
  573. ZPC    =0        ;PC CODE FOR ZERO PAGE PC
  574. P6PC    =1        ;PC CODE FOR PAGE 6
  575. PPC    =2        ;PC CODE FOR PROGRAM MEMORY
  576.  
  577. ;INIT PC VALUES
  578.  
  579. CURPC    =0
  580. PC0    =0        ;PAGE ZERO
  581. PC1    =$600        ;PAGE 6 PC
  582. PC2    =$3800        ;PROGRAM PC
  583. ;
  584. ; End of SYSMAC.SML
  585. ;----------------------------------------------------------------
  586.  
  587. ;.SBTTL    Parser support
  588.  
  589. ;  Define storage for pointers into command buffer. They must be
  590. ;  on zero-page to take advantage of pre- and post-indexed indirect
  591. ;  and also the simulated indirect addressing mode.
  592.  
  593. saddr    =    $80        ; Saved string address - must be on page zero
  594. cm.rty  =    $82        ; Byte pointer to CTRL/R Text
  595. cm.bfp  =    $84        ; Byte pointer to start of text buffer
  596. cm.ptr  =    $86        ; Byte pointer to Next Input to be parsed
  597. cm.inc  =    $88        ; Number of characters left in buffer
  598. cm.cnt  =    $89        ; Space left in buffer
  599. cminf1  =    $8A        ; Information passed to comnd routines
  600. cminf2  =    $8C        ;        ...
  601. cmdptr    =    cminf2        ; Pointer to default for parse
  602. cmkptr  =    $8E        ; Pointer for Cmkeyw routine
  603. cmsptr  =    $90        ; Saved character pointer
  604. cmspt2  =    $92        ; Saved keyword table pointer
  605. cmspt3  =    $94        ; Saved buffer pointer
  606. cmhptr  =    $96        ; Ptr. to current help text
  607. cmptab  =    $98        ; Ptr. to beginning of current keyword table
  608. cmfcb    =    $9A        ; Pointer to FCB
  609. cmehpt    =    $9C        ; Pointer to help commands
  610. ;
  611. ;    other leftover pointers that have to be in page 0
  612. ;
  613. kerbf1  =    $A0        ; This always points to packet buffer
  614. kerbf2    =    $A2        ; This always points to data buffer
  615.  
  616. ;----------------------------------------------------------------
  617. ; pointers we need
  618. ;
  619. source    =    $A4        ;[19] indirect address to be read
  620. dest    =    $A6        ;[19] indirect address to be stored    
  621. strptr    =    $A8        ;[jrd] temp for pointing into strings
  622. count    =    $AC        ;[jrd] count for mbs
  623. tmpptr    =    $AE        ; [jrd] temp for strictly local pointer hacking
  624. ;
  625. ; pointers for pathname parsing stuff
  626. ;
  627. pndptr    =    $B0        ; pathname descriptor ptr
  628. pnddef    =    $B2        ; pathname target ptr, for merging
  629. pnptr    =    $B4        ; pathname txt ptr
  630. pncptr    =    $B6        ; pathname component pointer
  631. ;
  632. ; device names and other atari type data
  633. ;
  634. ;kbdname: .byte    "K:"        ; not used in new kbd driver
  635. ;    .byte    ATEOL
  636. scrname: .byte    "E:"
  637.     .byte    ATEOL
  638. comname: .byte    "R:"
  639.     .byte    ATEOL
  640. comopen: .byte    0        ; flag for com port open
  641. comstat: .byte    0        ; status of com port, from last status op
  642. compend: .word    0        ; count of pending chars from port
  643. ;
  644. ;----------------------------------------------------------------
  645.  
  646. char:    .byte    $00        ;[26] Character just read
  647. stat:    .byte    $00        ;[33] RS232 status byte
  648. lpcnt:    .byte    $00        ;[EL] cursor blink counter
  649. ;lineh:    .byte    $00        ;[19] hires cursor line number
  650. ;colh:    .byte    $00        ;[19] hires cursor column number
  651. ;hilo:    .byte    $F0        ;[19] hires nibble mask
  652. ;rvmask:    .byte    $00        ;[19] reverse video mask ($f=rev, $0=normal)
  653. ;cflag:    .byte    $FF        ;[19] 0 if char under cursor has been reversed
  654. ;cstate:    .byte    $00        ;[19] top nibble of char und. cursor if cflag=0
  655. ;flag79:    .byte    $00        ;[19] non-0 if previous char printed in col 79
  656. ;fla79:    .byte    $00        ;[19] one shot copy of previous flag79
  657. suspend: .byte    $00        ;[24] RS-232 reads suspended if non-zero
  658. fxoff:    .byte    $00        ;[24] Xoff has been sent if non-zero
  659. ;commflg: .byte    $00        ;[24] non-zero if commodore key is depressed
  660.  
  661. .SBTTL    Translation and Font Tables
  662.  
  663. ;    ASCII/ATASCII Translation Tables
  664. ;    These are used for translating file data
  665. ;
  666. ;    At2as:    atascii -> ascii
  667. ; 
  668. ;at2as:    .byte    $00    ;[31] ^@ NUL
  669. ;    .byte    $01    ;[31] ^A SOH
  670. ;    .byte    $02    ;[31] ^B 
  671. ;    .byte    $03    ;[31] ^C 
  672. ;    .byte    $04    ;[31] ^D 
  673. ;    .byte    $05    ;[31] ^E 
  674. ;    .byte    $06    ;[31] ^F 
  675. ;    .byte    $07    ;[31] ^G BEL
  676. ;    .byte    $08    ;[31] ^H BS
  677. ;    .byte    $09    ;[31] ^I TAB
  678. ;    .byte    $0a    ;[31] ^J LF
  679. ;    .byte    $0b    ;[31] ^K 
  680. ;    .byte    $0c    ;[31] ^L FF
  681. ;    .byte    $0d    ;[31] ^M CR
  682. ;    .byte    $0e    ;[31] ^N 
  683. ;    .byte    $0f    ;[31] ^O 
  684. ;    .byte    $10    ;[31] ^P 
  685. ;    .byte    $11    ;[31] ^Q 
  686. ;    .byte    $12    ;[31] ^R 
  687. ;    .byte    $13    ;[31] ^S 
  688. ;    .byte    $14    ;[31] ^T
  689. ;    .byte    $15    ;[31] ^U 
  690. ;    .byte    $16    ;[31] ^V 
  691. ;    .byte    $17    ;[31] ^W 
  692. ;    .byte    $18    ;[31] ^X 
  693. ;    .byte    $19    ;[31] ^Y 
  694. ;    .byte    $1a    ;[31] ^Z 
  695. ;    .byte    $1b    ;[31] ^[ 
  696. ;    .byte    $1c    ;[31] ^\ 
  697. ;    .byte    $1d    ;[31] ^] 
  698. ;    .byte    $1e    ;[31] ^^ 
  699. ;    .byte    $1f    ;[31] ^_ 
  700. ;    .byte    $20    ;[31] SPACE
  701. ;    .byte    '!    ;[31] ! 
  702. ;    .byte    '"    ;[31] " 
  703. ;    .byte    '#    ;[31] # 
  704. ;    .byte    '$    ;[31] $ 
  705. ;    .byte    '%    ;[31] % 
  706. ;    .byte    '&    ;[31] & 
  707. ;    .byte    ''    ;[31] ' 
  708. ;    .byte    '(    ;[31] ( 
  709. ;    .byte    ')    ;[31] ) 
  710. ;    .byte    '*    ;[31] * 
  711. ;    .byte    '+    ;[31] + 
  712. ;    .byte    ',    ;[31] , 
  713. ;    .byte    '-    ;[31] - 
  714. ;    .byte    '.    ;[31] . 
  715. ;    .byte    '/    ;[31] / 
  716. ;    .byte    '0    ;[31] 0 
  717. ;    .byte    '1    ;[31] 1 
  718. ;    .byte    '2    ;[31] 2 
  719. ;    .byte    '3    ;[31] 3 
  720. ;    .byte    '4    ;[31] 4 
  721. ;    .byte    '5    ;[31] 5 
  722. ;    .byte    '6    ;[31] 6 
  723. ;    .byte    '7    ;[31] 7 
  724. ;    .byte    '8    ;[31] 8 
  725. ;    .byte    '9    ;[31] 9 
  726. ;    .byte    ':    ;[31] : 
  727. ;    .byte    ';    ;[31] ; 
  728. ;    .byte    '<    ;[31] < 
  729. ;    .byte    '=    ;[31] = 
  730. ;    .byte    '>    ;[31] > 
  731. ;    .byte    '?    ;[31] ? 
  732. ;    .byte    '@    ;[31] @ 
  733. ;    .byte    'A    ;[31] A
  734. ;    .byte    'B    ;[31] B
  735. ;    .byte    'C    ;[31] C
  736. ;    .byte    'D    ;[31] D 
  737. ;    .byte    'E    ;[31] E 
  738. ;    .byte    'F    ;[31] F 
  739. ;    .byte    'G    ;[31] G 
  740. ;    .byte    'H    ;[31] H 
  741. ;    .byte    'I    ;[31] I 
  742. ;    .byte    'J    ;[31] J 
  743. ;    .byte    'K    ;[31] K 
  744. ;    .byte    'L    ;[31] L 
  745. ;    .byte    'M    ;[31] M 
  746. ;    .byte    'N    ;[31] N 
  747. ;    .byte    'O    ;[31] O 
  748. ;    .byte    'P    ;[31] P 
  749. ;    .byte    'Q    ;[31] Q 
  750. ;    .byte    'R    ;[31] R 
  751. ;    .byte    'S    ;[31] S 
  752. ;    .byte    'T    ;[31] T 
  753. ;    .byte    'U    ;[31] U 
  754. ;    .byte    'V    ;[31] V 
  755. ;    .byte    'W    ;[31] W 
  756. ;    .byte    'X    ;[31] X 
  757. ;    .byte    'Y    ;[31] Y 
  758. ;    .byte    'Z    ;[31] Z 
  759. ;    .byte    '[    ;[31] [ 
  760. ;    .byte    '\    ;[31] \ 
  761. ;    .byte    ']    ;[31] ] 
  762. ;    .byte    '^    ;[31] ^ 
  763. ;    .byte    '_    ;[31] _
  764. ;    .byte    $60    ;[31] 
  765. ;    .byte    'a    ;[31] a 
  766. ;    .byte    'b    ;[31] b 
  767. ;    .byte    'c    ;[31] c 
  768. ;    .byte    'd    ;[31] d 
  769. ;    .byte    'e    ;[31] e 
  770. ;    .byte    'f    ;[31] f 
  771. ;    .byte    'g    ;[31] g 
  772. ;    .byte    'h    ;[31] h 
  773. ;    .byte    'i    ;[31] i 
  774. ;    .byte    'j    ;[31] j 
  775. ;    .byte    'k    ;[31] k 
  776. ;    .byte    'l    ;[31] l 
  777. ;    .byte    'm    ;[31] m 
  778. ;    .byte    'n    ;[31] n 
  779. ;    .byte    'o    ;[31] o 
  780. ;    .byte    'p    ;[31] p 
  781. ;    .byte    'q    ;[31] q 
  782. ;    .byte    'r    ;[31] r 
  783. ;    .byte    's    ;[31] s 
  784. ;    .byte    't    ;[31] t 
  785. ;    .byte    'u    ;[31] u 
  786. ;    .byte    'v    ;[31] v 
  787. ;    .byte    'w    ;[31] w 
  788. ;    .byte    'x    ;[31] x 
  789. ;    .byte    'y    ;[31] y 
  790. ;    .byte    'z    ;[31] z 
  791. ;    .byte    '{    ;[31] { 
  792. ;    .byte    '|    ;[31] | 
  793. ;    .byte    '}    ;[31] } 
  794. ;    .byte    '~    ;[31] ~ 
  795. ;    .byte    $7f    ;[31] DEL
  796. ;    .byte    '?    ;[31] illegal
  797. ;    .byte    '?    ;[31]
  798. ;    .byte    '?    ;[31]
  799. ;    .byte    '?    ;[31]
  800. ;    .byte    '?    ;[31]
  801. ;    .byte    '?    ;[31]
  802. ;    .byte    '?    ;[31]
  803. ;    .byte    '?    ;[31]
  804. ;    .byte    '?    ;[31]
  805. ;    .byte    '?    ;[31]
  806. ;    .byte    '?    ;[31]
  807. ;    .byte    '?    ;[31]
  808. ;    .byte    '?    ;[31]
  809. ;    .byte    '?    ;[31]
  810. ;    .byte    '?    ;[31] illegal
  811. ;    .byte    '?    ;[31] illegal
  812. ;    .byte    '?    ;[31] illegal
  813. ;    .byte    '?    ;[31] illegal
  814. ;    .byte    '?    ;[31] illegal
  815. ;    .byte    '?    ;[31] illegal
  816. ;    .byte    '?    ;[31] illegal
  817. ;    .byte    '?    ;[31] illegal
  818. ;    .byte    '?    ;[31] illegal
  819. ;    .byte    '?    ;[31] illegal
  820. ;    .byte    '?    ;[31] illegal
  821. ;    .byte    '?    ;[31] illegal
  822. ;    .byte    '?    ;[31] illegal
  823. ;    .byte    $0D    ; [jrd] atascii EOL -> CR
  824. ;    .byte    '?    ;[31] illegal
  825. ;    .byte    '?    ;[31] illegal
  826. ;    .byte    '?    ;[31] illegal
  827. ;    .byte    '?    ;[31] illegal
  828. ;    .byte    '?    ;[31] illegal
  829. ;    .byte    '?    ;[31] illegal
  830. ;    .byte    '?    ;[31] illegal
  831. ;    .byte    '?    ;[31] illegal
  832. ;    .byte    '?    ;[31] illegal
  833. ;    .byte    '?    ;[31] illegal
  834. ;    .byte    '?    ;[31] illegal
  835. ;    .byte    '?    ;[31] illegal
  836. ;    .byte    '?    ;[31] illegal
  837. ;    .byte    '?    ;[31] illegal
  838. ;    .byte    '?    ;[31] illegal
  839. ;    .byte    '?    ;[31] illegal
  840. ;    .byte    '?    ;[31] illegal
  841. ;    .byte    '?    ;[31] illegal
  842. ;    .byte    '?    ;[31] illegal
  843. ;    .byte    '?    ;[31] illegal
  844. ;    .byte    '?    ;[31] illegal
  845. ;    .byte    '?    ;[31] illegal
  846. ;    .byte    '?    ;[31] illegal
  847. ;    .byte    '?    ;[31] illegal
  848. ;    .byte    '?    ;[31] illegal
  849. ;    .byte    '?    ;[31] illegal
  850. ;    .byte    '?    ;[31] illegal
  851. ;    .byte    '?    ;[31] illegal
  852. ;    .byte    '?    ;[31] illegal
  853. ;    .byte    '?    ;[31] illegal
  854. ;    .byte    '?    ;[31] illegal
  855. ;    .byte    '?    ;[31] illegal
  856. ;    .byte    '?    ;[31] illegal
  857. ;    .byte    '?    ;[31] illegal
  858. ;    .byte    '?    ;[31] illegal
  859. ;    .byte    '?    ;[31] illegal
  860. ;    .byte    '?    ;[31] illegal
  861. ;    .byte    'A    ;[31] A from A key (dup)
  862. ;    .byte    'B    ;[31] B from B key (dup)
  863. ;    .byte    'C    ;[31] C from C key (dup)
  864. ;    .byte    'D    ;[31] D from D key (dup)
  865. ;    .byte    'E    ;[31] E from E key (dup)
  866. ;    .byte    'F    ;[31] F from F key (dup)
  867. ;    .byte    'G    ;[31] G from G key (dup)
  868. ;    .byte    'H    ;[31] H from H key (dup)
  869. ;    .byte    'I    ;[31] I from I key (dup)
  870. ;    .byte    'J    ;[31] J from J key (dup)
  871. ;    .byte    'K    ;[31] K from K key (dup)
  872. ;    .byte    'L    ;[31] L from L key (dup)
  873. ;    .byte    'M    ;[31] M from M key (dup)
  874. ;    .byte    'N    ;[31] N from N key (dup)
  875. ;    .byte    'O    ;[31] O from O key (dup)
  876. ;    .byte    'P    ;[31] P from P key (dup)
  877. ;    .byte    'Q    ;[31] Q from Q key (dup)
  878. ;    .byte    'R    ;[31] R from R key (dup)
  879. ;    .byte    'S    ;[31] S from S key (dup)
  880. ;    .byte    'T    ;[31] T from T key (dup)
  881. ;    .byte    'U    ;[31] U from U key (dup)
  882. ;    .byte    'V    ;[31] V from V key (dup)
  883. ;    .byte    'W    ;[31] W from W key (dup)
  884. ;    .byte    'X    ;[31] X from X key (dup)
  885. ;    .byte    'Y    ;[31] Y from Y key (dup)
  886. ;    .byte    'Z    ;[31] Z from Z key (dup)
  887. ;    .byte    '{    ;[31] { from SHIFT/+ key (dup)
  888. ;    .byte    '|    ;[31] | from ????? (dup)
  889. ;    .byte    '}    ;[31] } from SHIFT/- key (dup)
  890. ;    .byte    '~    ;[31] ~ from SHIFT/^ key (dup)
  891. ;    .byte    $7f    ;[31] DEL from ?????
  892. ;    .byte    $20    ;[31] SPACE from SHIFT/SPACE key (dup)
  893. ;    .byte    '?    ;[31] illegal
  894. ;    .byte    '?    ;[31] illegal
  895. ;    .byte    '?    ;[31] illegal
  896. ;    .byte    '?    ;[31] illegal
  897. ;    .byte    '?    ;[31] illegal
  898. ;    .byte    '?    ;[31] illegal
  899. ;    .byte    '?    ;[31] illegal
  900. ;    .byte    '?    ;[31] illegal
  901. ;    .byte    '?    ;[31] illegal
  902. ;    .byte    '?    ;[31] illegal
  903. ;    .byte    '?    ;[31] illegal
  904. ;    .byte    '?    ;[31] illegal
  905. ;    .byte    '?    ;[31] illegal
  906. ;    .byte    '?    ;[31] illegal
  907. ;    .byte    '?    ;[31] illegal
  908. ;    .byte    '?    ;[31] illegal
  909. ;    .byte    '?    ;[31] illegal
  910. ;    .byte    '?    ;[31] illegal
  911. ;    .byte    '?    ;[31] illegal
  912. ;    .byte    '?    ;[31] illegal
  913. ;    .byte    '?    ;[31] illegal
  914. ;    .byte    '?    ;[31] illegal
  915. ;    .byte    '?    ;[31] illegal
  916. ;    .byte    '?    ;[31] illegal
  917. ;    .byte    '?    ;[31] illegal
  918. ;    .byte    '?    ;[31] illegal
  919. ;    .byte    '?    ;[31] illegal
  920. ;    .byte    '?    ;[31] illegal
  921. ;    .byte    '?    ;[31] illegal
  922. ;    .byte    '?    ;[31] illegal
  923. ;    .byte    '?    ;[31] illegal
  924.  
  925. ;
  926. ; compressed form translate table
  927. ;
  928. xat2as:
  929.     .byte    ATEOL,cr        ; Atascii EOL -> cr
  930.     .byte    ATTAB,tab
  931.     .byte    ATBEL,bel
  932.     .byte    ATRUB,del
  933.     .byte    0
  934.  
  935. ;    As2at - ASCII to ATASCII
  936.  
  937. ;as2at:    .byte    $00    ;[31] NUL
  938. ;    .byte    $01    ;[31] ^A 
  939. ;    .byte    $02    ;[31] ^B 
  940. ;    .byte    $03    ;[31] ^C 
  941. ;    .byte    $04    ;[31] ^D 
  942. ;    .byte    $05    ;[31] ^E 
  943. ;    .byte    $06    ;[31] ^F 
  944. ;    .byte    $07    ;[31] BEL
  945. ;    .byte    $08    ;[31] BS
  946. ;    .byte    $09    ;[31] TAB
  947. ;    .byte    $0a    ;[31] NL
  948. ;    .byte    $0b    ;[31] ^K 
  949. ;    .byte    $0c    ;[31] ^L 
  950. ;    .byte    ATEOL    ;[31] CR 
  951. ;    .byte    $0e    ;[31] ^N 
  952. ;    .byte    $0f    ;[31] ^O 
  953. ;    .byte    $10    ;[31] ^P 
  954. ;    .byte    $11    ;[31] ^Q 
  955. ;    .byte    $12    ;[31] ^R 
  956. ;    .byte    $13    ;[31] ^S 
  957. ;    .byte    $14    ;[31] ^T 
  958. ;    .byte    $15    ;[31] ^U 
  959. ;    .byte    $16    ;[31] ^V 
  960. ;    .byte    $17    ;[31] ^W 
  961. ;    .byte    $18    ;[31] ^X 
  962. ;    .byte    $19    ;[31] ^Y 
  963. ;    .byte    $1a    ;[31] ^Z 
  964. ;    .byte    $1b    ;[31] ^[ 
  965. ;    .byte    $1c    ;[31] ^\ 
  966. ;    .byte    $1d    ;[31] ^] 
  967. ;    .byte    $1e    ;[31] ^^ 
  968. ;    .byte    $1f    ;[31] ^_ 
  969. ;    .byte    $20    ;[31] SPACE
  970. ;    .byte    $21    ;[31] ! 
  971. ;    .byte    $22    ;[31] " 
  972. ;    .byte    $23    ;[31] # 
  973. ;    .byte    $24    ;[31] $ 
  974. ;    .byte    $25    ;[31] % 
  975. ;    .byte    $26    ;[31] & 
  976. ;    .byte    $27    ;[31] ' 
  977. ;    .byte    $28    ;[31] ( 
  978. ;    .byte    $29    ;[31] ) 
  979. ;    .byte    $2a    ;[31] * 
  980. ;    .byte    $2b    ;[31] + 
  981. ;    .byte    $2c    ;[31] , 
  982. ;    .byte    $2d    ;[31] - 
  983. ;    .byte    $2e    ;[31] . 
  984. ;    .byte    $2f    ;[31] / 
  985. ;    .byte    $30    ;[31] 0 
  986. ;    .byte    $31    ;[31] 1 
  987. ;    .byte    $32    ;[31] 2 
  988. ;    .byte    $33    ;[31] 3 
  989. ;    .byte    $34    ;[31] 4 
  990. ;    .byte    $35    ;[31] 5 
  991. ;    .byte    $36    ;[31] 6 
  992. ;    .byte    $37    ;[31] 7 
  993. ;    .byte    $38    ;[31] 8 
  994. ;    .byte    $39    ;[31] 9 
  995. ;    .byte    $3a    ;[31] : 
  996. ;    .byte    $3b    ;[31] ; 
  997. ;    .byte    $3c    ;[31] < 
  998. ;    .byte    $3d    ;[31] = 
  999. ;    .byte    $3e    ;[31] > 
  1000. ;    .byte    $3f    ;[31] ? 
  1001. ;    .byte    '@     ;[31] @ 
  1002. ;    .byte    'A    ;[31] A
  1003. ;    .byte    'B    ;[31] B
  1004. ;    .byte    'C    ;[31] C
  1005. ;    .byte    'D    ;[31] D 
  1006. ;    .byte    'E    ;[31] E 
  1007. ;    .byte    'F    ;[31] F 
  1008. ;    .byte    'G    ;[31] G 
  1009. ;    .byte    'H    ;[31] H 
  1010. ;    .byte    'I    ;[31] I 
  1011. ;    .byte    'J    ;[31] J 
  1012. ;    .byte    'K    ;[31] K 
  1013. ;    .byte    'L    ;[31] L 
  1014. ;    .byte    'M    ;[31] M 
  1015. ;    .byte    'N    ;[31] N 
  1016. ;    .byte    'O    ;[31] O 
  1017. ;    .byte    'P    ;[31] P 
  1018. ;    .byte    'Q    ;[31] Q 
  1019. ;    .byte    'R    ;[31] R 
  1020. ;    .byte    'S    ;[31] S 
  1021. ;    .byte    'T    ;[31] T 
  1022. ;    .byte    'U    ;[31] U 
  1023. ;    .byte    'V    ;[31] V 
  1024. ;    .byte    'W    ;[31] W 
  1025. ;    .byte    'X    ;[31] X 
  1026. ;    .byte    'Y    ;[31] Y 
  1027. ;    .byte    'Z    ;[31] Z 
  1028. ;    .byte    $5b    ;[31] [ 
  1029. ;    .byte    $5c    ;[31] \ 
  1030. ;    .byte    $5d    ;[31] ] 
  1031. ;    .byte    $5e    ;[31] ^ 
  1032. ;    .byte    $5f    ;[31] _ 
  1033. ;    .byte    $60    ;[31][52]
  1034. ;    .byte    'a    ;[31] a 
  1035. ;    .byte    'b    ;[31] b 
  1036. ;    .byte    'c    ;[31] c 
  1037. ;    .byte    'd    ;[31] d 
  1038. ;    .byte    'e    ;[31] e 
  1039. ;    .byte    'f    ;[31] f 
  1040. ;    .byte    'g    ;[31] g 
  1041. ;    .byte    'h    ;[31] h 
  1042. ;    .byte    'i    ;[31] i 
  1043. ;    .byte    'j    ;[31] j 
  1044. ;    .byte    'k    ;[31] k 
  1045. ;    .byte    'l    ;[31] l 
  1046. ;    .byte    'm    ;[31] m 
  1047. ;    .byte    'n    ;[31] n 
  1048. ;    .byte    'o    ;[31] o 
  1049. ;    .byte    'p    ;[31] p 
  1050. ;    .byte    'q    ;[31] q 
  1051. ;    .byte    'r    ;[31] r 
  1052. ;    .byte    's    ;[31] s 
  1053. ;    .byte    't    ;[31] t 
  1054. ;    .byte    'u    ;[31] u 
  1055. ;    .byte    'v    ;[31] v 
  1056. ;    .byte    'w    ;[31] w 
  1057. ;    .byte    'x    ;[31] x 
  1058. ;    .byte    'y    ;[31] y 
  1059. ;    .byte    'z    ;[31] z 
  1060. ;    .byte    '[    ; [jrd] what to do with these on atari?
  1061. ;    .byte    '|    ;[31][52] | 
  1062. ;    .byte    ']    ;[31][52] }
  1063. ;    .byte    $60    ;[31][52] ~ 
  1064. ;    .byte    ATRUB    ;[31] DEL
  1065.  
  1066.  
  1067. ;
  1068. ; compressed form translate table
  1069. ;
  1070. xas2at:
  1071.     .byte    cr,ATEOL        ; cr -> Atascii EOL
  1072.     .byte    tab,ATTAB
  1073.     .byte    bel,ATBEL
  1074.     .byte    del,ATRUB
  1075.     .byte    0
  1076.  
  1077. ;
  1078. ;    These are used for translating to/from ascii in terminal rtn 
  1079. ;    To - ATASCII to ASCII
  1080. ;
  1081. ;attoas:    .byte    $00    ;[31] ^@ from ^@ key (NUL)
  1082. ;    .byte    $01    ;[31] ^A from ^A key
  1083. ;    .byte    $02    ;[31] ^B from ^B key
  1084. ;    .byte    $03    ; ^C from ^C key
  1085. ;    .byte    $04    ; ^D from ^D key
  1086. ;    .byte    $05    ; ^E from ^E key
  1087. ;    .byte    $06    ; ^F from ^F key
  1088. ;    .byte    $07    ; ^G from ^G key
  1089. ;    .byte    $08    ; ^H from ^H key
  1090. ;    .byte    $09    ; ^I from ^I key
  1091. ;    .byte    $0a    ; ^J from ^J key
  1092. ;    .byte    $0b    ; ^K from ^K key
  1093. ;    .byte    $0c    ; ^L from ^L key
  1094. ;    .byte    $0d    ; ^M from ^M and RETURN keys
  1095. ;    .byte    $0e    ; ^N from ^N key
  1096. ;    .byte    $0f    ; ^O from ^O key
  1097. ;    .byte    $10    ; ^P from ^P key
  1098. ;    .byte    $11    ; ^Q from ^Q and CURS DOWN keys
  1099. ;    .byte    $12    ; ^R from ^R key
  1100. ;    .byte    $13    ; ^S from ^S and HOME keys
  1101. ;    .byte    $14    ; DEL from ^T and DEL keys
  1102. ;    .byte    $15    ; ^U from ^U key
  1103. ;    .byte    $16    ; ^V from ^V key
  1104. ;    .byte    $17    ; ^W from ^W key
  1105. ;    .byte    $18    ; ^X from ^X key
  1106. ;    .byte    $19    ; ^Y from ^Y key
  1107. ;    .byte    $1A    ; ^Z from ^Z key
  1108. ;    .byte    $1B    ; ^[ from ^[ key
  1109. ;    .byte    $1C    ; atari up arrow
  1110. ;    .byte    $1D    ; down arrow
  1111. ;    .byte    $1E    ; left arrow
  1112. ;    .byte    $1F    ; right arrow
  1113. ;    .byte    $20    ; SPACE from SPACE bar
  1114. ;    .byte    '!    ; ! from ! key
  1115. ;    .byte    '"    ; " from " key
  1116. ;    .byte    '#    ; # from # key
  1117. ;    .byte    '$    ; $ from $ key
  1118. ;    .byte    '%    ; % from % key
  1119. ;    .byte    '&    ; & from & key
  1120. ;    .byte    ''    ; ' from ' key
  1121. ;    .byte    '(    ; ( from ( key
  1122. ;    .byte    ')    ; ) from ) key
  1123. ;    .byte    '*    ; * from * key
  1124. ;    .byte    '+    ; + from + key
  1125. ;    .byte    ',    ; , from , key
  1126. ;    .byte    '-    ; - from - key
  1127. ;    .byte    '.    ; . from . key
  1128. ;    .byte    '/    ; / from / key
  1129. ;    .byte    '0    ; 0 from 0 key
  1130. ;    .byte    '1    ; 1 from 1 key
  1131. ;    .byte    '2    ; 2 from 2 key
  1132. ;    .byte    '3    ; 3 from 3 key
  1133. ;    .byte    '4    ; 4 from 4 key
  1134. ;    .byte    '5    ; 5 from 5 key
  1135. ;    .byte    '6    ; 6 from 6 key
  1136. ;    .byte    '7    ; 7 from 7 key
  1137. ;    .byte    '8    ; 8 from 8 key
  1138. ;    .byte    '9    ; 9 from 9 key
  1139. ;    .byte    ':    ; : from : key
  1140. ;    .byte    ';    ; ; from ; key
  1141. ;    .byte    '<    ; < from < key
  1142. ;    .byte    '=    ; = from = key
  1143. ;    .byte    '>    ; > from > key
  1144. ;    .byte    '?    ; ? from ? key
  1145. ;    .byte    '@    ; @ from @ key
  1146. ;    .byte    'A    ; A from A key
  1147. ;    .byte    'B    ; B from B key
  1148. ;    .byte    'C    ; C from C key
  1149. ;    .byte    'D    ; D from D key
  1150. ;    .byte    'E    ; E from E key
  1151. ;    .byte    'F    ; F from F key
  1152. ;    .byte    'G    ; G from G key
  1153. ;    .byte    'H    ; H from H key
  1154. ;    .byte    'I    ; I from I key
  1155. ;    .byte    'J    ; J from J key
  1156. ;    .byte    'K    ; K from K key
  1157. ;    .byte    'L    ; L from L key
  1158. ;    .byte    'M    ; M from M key
  1159. ;    .byte    'N    ; N from N key
  1160. ;    .byte    'O    ; O from O key
  1161. ;    .byte    'P    ; P from P key
  1162. ;    .byte    'Q    ; Q from Q key
  1163. ;    .byte    'R    ; R from R key
  1164. ;    .byte    'S    ; S from S key
  1165. ;    .byte    'T    ; T from T key
  1166. ;    .byte    'U    ; U from U key
  1167. ;    .byte    'V    ; V from V key
  1168. ;    .byte    'W    ; W from W key
  1169. ;    .byte    'X    ; X from X key
  1170. ;    .byte    'Y    ; Y from Y key
  1171. ;    .byte    'Z    ; Z from Z key
  1172. ;    .byte    '[    ; [ from [ key
  1173. ;    .byte    '\    ; \ from POUND key
  1174. ;    .byte    ']    ; ] from ] key
  1175. ;    .byte    '^    ; ^ from ^ key (really UP ARROW)
  1176. ;    .byte    '_    ; _ from _ key
  1177. ;    .byte    $60    ;  SHIFT/* key
  1178. ;    .byte    'a    ; a from a key
  1179. ;    .byte    'b    ; b from b key
  1180. ;    .byte    'c    ; c from c key
  1181. ;    .byte    'd    ; d from d key
  1182. ;    .byte    'e    ; e from e key
  1183. ;    .byte    'f    ; f from f key
  1184. ;    .byte    'g    ; g from g key
  1185. ;    .byte    'h    ; h from h key
  1186. ;    .byte    'i    ; i from i key
  1187. ;    .byte    'j    ; j from j key
  1188. ;    .byte    'k    ; k from k key
  1189. ;    .byte    'l    ; l from l key
  1190. ;    .byte    'm    ; m from m key
  1191. ;    .byte    'n    ; n from n key
  1192. ;    .byte    'o    ; o from o key
  1193. ;    .byte    'p    ; p from p key
  1194. ;    .byte    'q    ; q from q key
  1195. ;    .byte    'r    ; r from r key
  1196. ;    .byte    's    ; s from s key
  1197. ;    .byte    't    ; t from t key
  1198. ;    .byte    'u    ; u from u key
  1199. ;    .byte    'v    ; v from v key
  1200. ;    .byte    'w    ; w from w key
  1201. ;    .byte    'x    ; x from x key
  1202. ;    .byte    'y    ; y from y key
  1203. ;    .byte    'z    ; z from z key
  1204. ;    .byte    '{    ; { from SHIFT/+ key
  1205. ;    .byte    '|    ; | from ?????
  1206. ;    .byte    '}    ; } from SHIFT/- key
  1207. ;    .byte    $7F    ; Atascii RUBOUT
  1208. ;    .byte    $09    ; Atascii TAB
  1209. ;    .byte    '?    ; illegal key
  1210. ;    .byte    '?    ; illegal key
  1211. ;    .byte    '?    ; illegal key
  1212. ;    .byte    '?    ; illegal key
  1213. ;    .byte    '?    ; illegal key
  1214. ;    .byte    '_    ; _ from F1 key
  1215. ;    .byte    $60    ;  F3 key
  1216. ;    .byte    '{    ; { from F5 key
  1217. ;    .byte    $08    ; ^H (BS) from F7 key
  1218. ;    .byte    '|    ; | from F2 key
  1219. ;    .byte    '~    ; ~ from F4 key
  1220. ;    .byte    '}    ; } from F6 key
  1221. ;    .byte    $14    ; ^T from F8 key
  1222. ;    .byte    $0a    ; NL from SHIFT/CR key
  1223. ;    .byte    '?    ; illegal key
  1224. ;    .byte    '?    ; illegal key
  1225. ;    .byte    '?    ; illegal key
  1226. ;    .byte    '?    ; illegal key
  1227. ;    .byte    '?    ; illegal key
  1228. ;    .byte    '?    ; illegal key
  1229. ;    .byte    '?    ; illegal key
  1230. ;    .byte    '?    ; illegal key
  1231. ;    .byte    '?    ; illegal key
  1232. ;    .byte    '?    ; illegal key
  1233. ;    .byte    '?    ; illegal key
  1234. ;    .byte    '?    ; illegal key
  1235. ;    .byte    '?    ; illegal key
  1236. ;    .byte    cr    ; Atascii EOL
  1237. ;    .byte    '?    ; illegal key
  1238. ;    .byte    '?    ; illegal key
  1239. ;    .byte    '?    ; illegal key
  1240. ;    .byte    '?    ; illegal key
  1241. ;    .byte    $20    ; SPACE from SHIFT/SPACE key
  1242. ;    .byte    '?    ; illegal key
  1243. ;    .byte    '?    ; illegal key
  1244. ;    .byte    '?    ; illegal key
  1245. ;    .byte    '?    ; illegal key
  1246. ;    .byte    '?    ; illegal key
  1247. ;    .byte    '?    ; illegal key
  1248. ;    .byte    '?    ; illegal key
  1249. ;    .byte    '?    ; illegal key
  1250. ;    .byte    '?    ; illegal key
  1251. ;    .byte    '?    ; illegal key
  1252. ;    .byte    '?    ; illegal key
  1253. ;    .byte    '?    ; illegal key
  1254. ;    .byte    '?    ; illegal key
  1255. ;    .byte    '?    ; illegal key
  1256. ;    .byte    '?    ; illegal key
  1257. ;    .byte    '?    ; illegal key
  1258. ;    .byte    '?    ; illegal key
  1259. ;    .byte    '?    ; illegal key
  1260. ;    .byte    '?    ; illegal key
  1261. ;    .byte    '?    ; illegal key
  1262. ;    .byte    '?    ; illegal key
  1263. ;    .byte    '?    ; illegal key
  1264. ;    .byte    '?    ; illegal key
  1265. ;    .byte    '?    ; illegal key
  1266. ;    .byte    '?    ; illegal key
  1267. ;    .byte    '?    ; illegal key
  1268. ;    .byte    '?    ; illegal key
  1269. ;    .byte    '?    ; illegal key
  1270. ;    .byte    '?    ; illegal key
  1271. ;    .byte    '?    ; illegal key
  1272. ;    .byte    '?    ; illegal key
  1273. ;    .byte    $60    ;  SHIFT/* key (dup)
  1274. ;    .byte    'A    ; A from A key (dup)
  1275. ;    .byte    'B    ; B from B key (dup)
  1276. ;    .byte    'C    ; C from C key (dup)
  1277. ;    .byte    'D    ; D from D key (dup)
  1278. ;    .byte    'E    ; E from E key (dup)
  1279. ;    .byte    'F    ; F from F key (dup)
  1280. ;    .byte    'G    ; G from G key (dup)
  1281. ;    .byte    'H    ; H from H key (dup)
  1282. ;    .byte    'I    ; I from I key (dup)
  1283. ;    .byte    'J    ; J from J key (dup)
  1284. ;    .byte    'K    ; K from K key (dup)
  1285. ;    .byte    'L    ; L from L key (dup)
  1286. ;    .byte    'M    ; M from M key (dup)
  1287. ;    .byte    'N    ; N from N key (dup)
  1288. ;    .byte    'O    ; O from O key (dup)
  1289. ;    .byte    'P    ; P from P key (dup)
  1290. ;    .byte    'Q    ; Q from Q key (dup)
  1291. ;    .byte    'R    ; R from R key (dup)
  1292. ;    .byte    'S    ; S from S key (dup)
  1293. ;    .byte    'T    ; T from T key (dup)
  1294. ;    .byte    'U    ; U from U key (dup)
  1295. ;    .byte    'V    ; V from V key (dup)
  1296. ;    .byte    'W    ; W from W key (dup)
  1297. ;    .byte    'X    ; X from X key (dup)
  1298. ;    .byte    'Y    ; Y from Y key (dup)
  1299. ;    .byte    'Z    ; Z from Z key (dup)
  1300. ;    .byte    '{    ; { from SHIFT/+ key (dup)
  1301. ;    .byte    '|    ; | from ????? (dup)
  1302. ;    .byte    '}    ; } from SHIFT/- key (dup)
  1303. ;    .byte    '~    ; ~ from SHIFT/^ key (dup)
  1304. ;    .byte    $7f    ; DEL from ?????
  1305. ;    .byte    $20    ; SPACE from SHIFT/SPACE key (dup)
  1306. ;    .byte    '?    ; illegal key
  1307. ;    .byte    '?    ; illegal key
  1308. ;    .byte    '?    ; illegal key
  1309. ;    .byte    '?    ; illegal key
  1310. ;    .byte    '?    ; illegal key
  1311. ;    .byte    '?    ; illegal key
  1312. ;    .byte    '?    ; illegal key
  1313. ;    .byte    '?    ; illegal key
  1314. ;    .byte    '?    ; illegal key
  1315. ;    .byte    '?    ; illegal key
  1316. ;    .byte    '?    ; illegal key
  1317. ;    .byte    '?    ; illegal key
  1318. ;    .byte    '?    ; illegal key
  1319. ;    .byte    '?    ; illegal key
  1320. ;    .byte    '?    ; illegal key
  1321. ;    .byte    '?    ; illegal key
  1322. ;    .byte    '?    ; illegal key
  1323. ;    .byte    '?    ; illegal key
  1324. ;    .byte    '?    ; illegal key
  1325. ;    .byte    '?    ; illegal key
  1326. ;    .byte    '?    ; illegal key
  1327. ;    .byte    '?    ; illegal key
  1328. ;    .byte    '?    ; illegal key
  1329. ;    .byte    '?    ; illegal key
  1330. ;    .byte    '?    ; illegal key
  1331. ;    .byte    '?    ; illegal key
  1332. ;    .byte    '?    ; illegal key
  1333. ;    .byte    '?    ; illegal key
  1334. ;    .byte    '?    ; illegal key
  1335. ;    .byte    '?    ; illegal key
  1336. ;    .byte    '~    ; ~ from SHIFT/^ key (dup)
  1337.  
  1338. ;
  1339. ;    From ASCII to ATASCII (Terminal routine)
  1340. ;
  1341. ;    just use as2at
  1342. ;
  1343. ;astoat:    .byte    $00    ;[31] NUL doesn't print
  1344. ;    .byte    $00    ;[31] ^A doesn't print
  1345. ;    .byte    $00    ;[31] ^B doesn't print
  1346. ;    .byte    $00    ;[31] ^C doesn't print
  1347. ;    .byte    $00    ;[31] ^D doesn't print
  1348. ;    .byte    $00    ;[31] ^E doesn't print
  1349. ;    .byte    $00    ; ^F doesn't print
  1350. ;    .byte    $FD    ; -> Atari bell.  Fix this to use beeper?
  1351. ;    .byte    ATLRW    ; BS prints as CURSOR LEFT
  1352. ;    .byte    ATTAB    ; TAB is special
  1353. ;    .byte    $0A    ; zzz ATDRW    ; NL prints as CURSOR DOWN
  1354. ;    .byte    $00    ; ^K doesn't print
  1355. ;    .byte    $0C    ; ^L doesn't print 
  1356. ;    .byte    ATEOL    ; CR is special
  1357. ;    .byte    $00    ; ^N doesn't print 
  1358. ;    .byte    $00    ; ^O doesn't print
  1359. ;    .byte    $00    ; ^P doesn't print
  1360. ;    .byte    $00    ; ^Q doesn't print
  1361. ;    .byte    $00    ; ^R doesn't print
  1362. ;    .byte    $00    ; ^S doesn't print
  1363. ;    .byte    $00    ; ^T doesn't print
  1364. ;    .byte    $00    ; ^U doesn't print
  1365. ;    .byte    $00    ; ^V doesn't print
  1366. ;    .byte    $00    ; ^W doesn't print
  1367. ;    .byte    $00    ; ^X doesn't print
  1368. ;    .byte    $00    ; ^Y doesn't print
  1369. ;    .byte    $00    ; ^Z doesn't print
  1370. ;    .byte    $1B    ; escape
  1371. ;    .byte    $00    ; ^\ doesn't print
  1372. ;    .byte    $00    ; ^] doesn't print
  1373. ;    .byte    $00    ; ^^ doesn't print
  1374. ;    .byte    $00    ; ^_ doesn't print
  1375. ;    .byte    $20    ; SPACE prints as SPACE 
  1376. ;    .byte    $21    ; ! prints as !
  1377. ;    .byte    $22    ; " prints as "
  1378. ;    .byte    $23    ; # prints as #
  1379. ;    .byte    $24    ; $ prints as $
  1380. ;    .byte    $25    ; % prints as %
  1381. ;    .byte    $26    ; & prints as &
  1382. ;    .byte    $27    ; ' prints as '
  1383. ;    .byte    $28    ; ( prints as (
  1384. ;    .byte    $29    ; ) prints as )
  1385. ;    .byte    $2a    ; * prints as *
  1386. ;    .byte    $2b    ; + prints as +
  1387. ;    .byte    $2c    ; , prints as ,
  1388. ;    .byte    $2d    ; - prints as -
  1389. ;    .byte    $2e    ; . prints as .
  1390. ;    .byte    $2f    ; / prints as /
  1391. ;    .byte    $30    ; 0 prints as 0
  1392. ;    .byte    $31    ; 1 prints as 1
  1393. ;    .byte    $32    ; 2 prints as 2
  1394. ;    .byte    $33    ; 3 prints as 3
  1395. ;    .byte    $34    ; 4 prints as 4
  1396. ;    .byte    $35    ; 5 prints as 5
  1397. ;    .byte    $36    ; 6 prints as 6
  1398. ;    .byte    $37    ; 7 prints as 7
  1399. ;    .byte    $38    ; 8 prints as 8
  1400. ;    .byte    $39    ; 9 prints as 9
  1401. ;    .byte    $3a    ; : prints as :
  1402. ;    .byte    $3b    ; ; prints as ;
  1403. ;    .byte    $3c    ; < prints as <
  1404. ;    .byte    $3d    ; = prints as =
  1405. ;    .byte    $3e    ; > prints as >
  1406. ;    .byte    $3f    ; ? prints as ?
  1407. ;    .byte    $40    ; @ prints as @
  1408. ;    .byte    $41    ; a prints as a
  1409. ;    .byte    $42    ; b prints as b
  1410. ;    .byte    $43    ; c prints as c
  1411. ;    .byte    $44    ; d prints as d
  1412. ;    .byte    $45    ; e prints as e
  1413. ;    .byte    $46    ; f prints as f
  1414. ;    .byte    $47    ; g prints as g
  1415. ;    .byte    $48    ; h prints as h
  1416. ;    .byte    $49    ; i prints as i
  1417. ;    .byte    $4a    ; j prints as j
  1418. ;    .byte    $4b    ; k prints as k
  1419. ;    .byte    $4c    ; l prints as l
  1420. ;    .byte    $4d    ; m prints as m
  1421. ;    .byte    $4e    ; n prints as n
  1422. ;    .byte    $4f    ; o prints as o
  1423. ;    .byte    $50    ; p prints as p
  1424. ;    .byte    $51    ; q prints as q
  1425. ;    .byte    $52    ; r prints as r
  1426. ;    .byte    $53    ; s prints as s
  1427. ;    .byte    $54    ; t prints as t
  1428. ;    .byte    $55    ; u prints as u
  1429. ;    .byte    $56    ; v prints as v
  1430. ;    .byte    $57    ; w prints as w
  1431. ;    .byte    $58    ; x prints as x
  1432. ;    .byte    $59    ; y prints as y
  1433. ;    .byte    $5a    ; z prints as z
  1434. ;    .byte    $5b    ; [ prints as [
  1435. ;    .byte    $5c    ; \ prints as \
  1436. ;    .byte    $5d    ; ] prints as ]
  1437. ;    .byte    $5e    ; ^ prints as ^
  1438. ;    .byte    $5f    ; _ prints as _
  1439. ;    .byte    $60    ; 
  1440. ;    .byte    $61    ; A prints as A
  1441. ;    .byte    $62    ; B prints as B
  1442. ;    .byte    $63    ; C prints as C
  1443. ;    .byte    $64    ; D prints as D
  1444. ;    .byte    $65    ; E prints as E
  1445. ;    .byte    $66    ; F prints as F
  1446. ;    .byte    $67    ; G prints as G
  1447. ;    .byte    $68    ; H prints as H
  1448. ;    .byte    $69    ; I prints as I
  1449. ;    .byte    $6a    ; J prints as J
  1450. ;    .byte    $6b    ; K prints as K
  1451. ;    .byte    $6c    ; L prints as L
  1452. ;    .byte    $6d    ; M prints as M
  1453. ;    .byte    $6e    ; N prints as N
  1454. ;    .byte    $6f    ; O prints as O
  1455. ;    .byte    $70    ; P prints as P
  1456. ;    .byte    $71    ; Q prints as Q
  1457. ;    .byte    $72    ; R prints as R
  1458. ;    .byte    $73    ; S prints as S
  1459. ;    .byte    $74    ; T prints as T
  1460. ;    .byte    $75    ; U prints as U
  1461. ;    .byte    $76    ; V prints as V
  1462. ;    .byte    $77    ; W prints as W
  1463. ;    .byte    $78    ; X prints as X
  1464. ;    .byte    $79    ; Y prints as Y
  1465. ;    .byte    $7a    ; Z prints as Z
  1466. ;    .byte    $7b    ; { prints as {
  1467. ;    .byte    $7c    ; | prints as |
  1468. ;    .byte    $7d    ; } prints as }
  1469. ;    .byte    $7e    ; ~ prints as ~
  1470. ;    .byte    ATRUB    ; -> atascii rubout
  1471.  
  1472. ;
  1473. ;    character translator.
  1474. ;
  1475. ;    calling sequence:
  1476. ;    char to xlate in A
  1477. ;    address of xlate tbl in X,Y
  1478. ; 
  1479. ;    returns:    xlated char in A
  1480. ;
  1481. xlchar:    .byte    0        ; temp for original byte
  1482. xlate:
  1483.     stx    tmpptr        ; set up xlate table ptr
  1484.     sty    tmpptr+1
  1485.     sta    xlchar        ; store the old data
  1486.     ldy    #0
  1487. xlate1:
  1488.     lda    (tmpptr),y    ; get a 'from' byte
  1489.     beq    xlate9        ; zero, we're done
  1490.     cmp    xlchar        ; match the one we're called with?
  1491.     beq    xlate2        ; yup, go translate it
  1492.     iny            ; bump y for next time
  1493.     iny            ; skip the wrong one
  1494.     jmp    xlate1
  1495. xlate2:
  1496.     iny            ; point at new one
  1497.     lda    (tmpptr),y    ; get get translated one
  1498.     rts            ; and go home
  1499. xlate9:
  1500.     lda    xlchar        ; no translation, just return the original
  1501.     rts
  1502. ;
  1503. ;----------------------------------------------------------------
  1504. ;
  1505. ; pathname parsing stuff.
  1506. ;
  1507. ; a pathname consists of optional device, name, and optional
  1508. ; extension.
  1509. ;
  1510. ; a pathname descriptor is a structure containing three fields,
  1511. ; each of which is a byte of max, a byte of length, and a (max) bytes
  1512. ; of data. they are:
  1513. ;    dev    device spec     (2 bytes)
  1514. ;    name    file name    (8 bytes)
  1515. ;    ext    file type    (3 bytes)
  1516. ;
  1517. ; equates for pathname descriptor block
  1518. ;
  1519. pnd.fl  =    0        ; flags byte
  1520. pnd.dm    =    1        ; dev max, 1 byte
  1521. pnd.ds    =    2        ; dev size, one byte
  1522. pnd.dt    =    3        ; dev text, two bytes
  1523. pnd.nm    =    5        ; name max, 1 byte
  1524. pnd.ns    =    6        ; name size, 1 byte
  1525. pnd.nt    =    7        ; name text, 8 bytes
  1526. pnd.em    =    15        ; ext max
  1527. pnd.es    =    16
  1528. pnd.et    =    17
  1529. pndsiz    =    20        ; total size
  1530. ;
  1531. ; generic component equates
  1532. ;
  1533. pnc.m    =    0        ; max this component
  1534. pnc.s    =    1        ; size this component
  1535. pnc.t    =    2        ; text this component
  1536. ;
  1537. ; bits in flag byte
  1538. ;
  1539. pnf.dp    =    $01        ; dev spec present
  1540. pnf.np    =    $02        ; name present
  1541. pnf.ep    =    $04        ; type present
  1542. pnf.wl    =    $08        ; wild card somewhere
  1543. ;
  1544. ; if we had macros, the macro for building one of these would
  1545. ; look like this:
  1546. ;
  1547. ;    .byte    0        ; flags
  1548. ;    .byte    2        ; dev max
  1549. ;    .byte    0
  1550. ;    .blkb    2
  1551. ;    .byte    8        ; name max
  1552. ;    .byte    0
  1553. ;    .blkb    8
  1554. ;    .byte    3
  1555. ;    .byte    0
  1556. ;    .blkb    3
  1557. ;
  1558. ppnt0:    .byte    0        ; temp for parse-pathname and friends
  1559. ppnt1:    .byte    0
  1560. ppnt2:    .byte    0
  1561. ;
  1562. ;    pncupc:        char-upcase char in A
  1563. ;
  1564. pncupc:
  1565.     cmp    #'a        ; >= 'a ?
  1566.     bcc    pncupc9        ; nope, leave
  1567.     cmp    #'z+1        ; < 'z?
  1568.     bcs    pncupc9        ; nope, leave
  1569.     sec
  1570.     sbc    #$20        ; shift to up case.  (carry's set)
  1571. pncupc9:
  1572.     rts
  1573. ;
  1574. ;    pnclgl:        char in a legal pathname char?
  1575. ;            returns carry set if not legal
  1576. ;
  1577. pnclgl:
  1578.     cmp    #':        ; colon's ok
  1579.     beq    pnclgl9
  1580.     cmp    #'.        ; dot's ok too
  1581.     beq    pnclgl9
  1582.     cmp    #'*        ; star is ok
  1583.     beq    pnclgl9
  1584.     cmp    #'?        ; q-mark is ok
  1585.     beq    pnclgl9
  1586.     cmp    #'0        ; 0..9 is ok
  1587.     bcc    pnclgl8        ;  less, no good
  1588.     cmp    #'9+1
  1589.     bcc    pnclgl9        ; less, ok
  1590.     cmp    #'A        ; alpha?
  1591.     bcc    pnclgl8        ; less is no good
  1592.     cmp    #'Z+1
  1593.     bcc    pnclgl9        ; A..Z's ok
  1594. pnclgl8:
  1595.     sec            ; error return
  1596.     rts
  1597. pnclgl9:
  1598.     clc            ; ok return
  1599.     rts
  1600. ;
  1601. ;    pnfindc:    find a character, in x, in (pnptr), starting
  1602. ;            at y.  returns idx or -1 in y, EQ if found, NEQ
  1603. ;            if not found.  Trashes A
  1604. ;
  1605. pnfindc:
  1606.     stx    ppnt1        ; save char
  1607. pnfindc1:
  1608.     lda    (pnptr),y    ; get a char
  1609.     beq    pnfindc8    ; 0? ok, stop here
  1610.     jsr    pncupc        ; upcase it
  1611.     jsr    pnclgl        ; legal pathname char?
  1612.     bcs    pnfindc8    ; nope, go error
  1613.     cmp    ppnt1        ; compare it
  1614.     beq    pnfindc9    ; got it, return
  1615.     iny            ; next!
  1616.     bne    pnfindc1
  1617. pnfindc8:
  1618.     ldy    #-1        ; return 'not found'
  1619. pnfindc9:
  1620.     rts
  1621. ;
  1622. ;    parsepn::
  1623. ;    grok a pathname string into a pathname descriptor.
  1624. ;    expects pathname string pointed to by x,y, desc in (pndptr).
  1625. ;    pathname string terminated by any non-pathname char.
  1626. ;
  1627. ; this routine copies in one component.  Initial idx in Y, terminating
  1628. ; character in X, component offset in desc in A
  1629. ;
  1630. ;ppndbg1: .byte    "Enter parsepn",ATEOL,0
  1631. ;ppndbg2: .byte    "Leave parsepn",ATEOL,0
  1632. ppnct:    .byte    0        ; terminator char
  1633. ppncf:    .byte    0        ; flags for pathname we're parsing
  1634. ppncpf:    .byte    0        ; flag to set in component we're on
  1635. ppncomp:
  1636.     stx    ppnct        ; save terminator
  1637.     clc            ; first calculate 
  1638.     adc    pndptr        ;  pointer to pathname
  1639.     sta    pncptr        ;  component
  1640.     lda    pndptr+1
  1641.     adc    #0
  1642.     sta    pncptr+1
  1643. ppncp1:
  1644.     lda    (pnptr),y    ; get a char
  1645. ; below?    iny            ; and bump the string idx
  1646.     beq    ppncp9        ; always terminate on nuls
  1647.     cmp    ppnct        ; hit terminator?
  1648.     beq    ppncp8        ; yes, stop this component
  1649.     cmp    #ATEOL        ; eol?
  1650.     beq    ppncp9        ; yes, always terminate on eols, too
  1651.     iny            ; and bump the string idx
  1652.     jsr    pncupc        ; upcase it
  1653.     jsr    pnclgl        ; legal char?
  1654.     bcs    ppncp9        ; nope, stop here
  1655.     cmp    #'*        ; is it one of the wild chars?
  1656.     beq    ppncp2        ; yes, flag it as such
  1657.     cmp    #'?
  1658.     bne    ppncp3
  1659. ppncp2:
  1660.     pha            ; save char
  1661.     lda    #pnf.wl        ; or in the 'wild' flag
  1662.     ora    ppncf
  1663.     sta    ppncf
  1664.     pla            ; get char back
  1665. ppncp3:
  1666.     sty    ppnt0        ; save y for a bit
  1667.     pha            ; save char
  1668.     ldy    #pnc.s        ; component size offset
  1669.     lda    (pncptr),y    ; get component size
  1670. ; check size
  1671.     ldy    #pnc.m        ; component max
  1672.     cmp    (pncptr),y    ; compare size to max
  1673.     bcs    ppncp6        ; too big! ignore this byte
  1674.     ldy    #pnc.s        ; idx for size again
  1675. ;
  1676.     pha            ; save size for later indexing
  1677.     clc            ; add one to it for
  1678.     adc    #1        ;  next time
  1679.     sta    (pncptr),y    ; put it back
  1680.     pla            ; get the old size (index) back
  1681.     clc            ; zap carry again, and
  1682.     adc    #pnc.t        ;  add dev text offset
  1683.     tay            ; into y
  1684.     pla            ; get char back
  1685.     sta    (pncptr),y    ; stuff into dev text
  1686.     lda    ppncpf        ; or in the flag corresponding to 
  1687.     ora    ppncf        ;  this component
  1688.     sta    ppncf
  1689.     jmp    ppncp7        ; and go back for more
  1690. ppncp6:
  1691.     pla            ; throw char away
  1692. ppncp7:
  1693.     ldy    ppnt0        ; get string idx back
  1694.     jmp    ppncp1
  1695. ppncp8:
  1696. ;
  1697. ; found terminator.  Skip it.
  1698.     iny
  1699. ;
  1700. ppncp9:
  1701.     rts
  1702. ;
  1703. ;    The main routine of the pathname parser.
  1704. ;
  1705. parsepn:
  1706.     stx    pnptr        ; set string pointer lo
  1707.     sty    pnptr+1        ;  and hi
  1708. ;zzz debug
  1709. ;    ldx    #ppndbg1\
  1710. ;    ldy    #ppndbg1^
  1711. ;    jsr    pstrnul
  1712. ;zzz
  1713.     lda    #0        ; first zap len flds in desc
  1714.     sta    ppncf        ; and flags in progress
  1715.     ldy    #pnd.ds        ; dev size
  1716.     sta    (pndptr),y    ; zap
  1717.     ldy    #pnd.ns
  1718.     sta    (pndptr),y
  1719.     ldy    #pnd.es
  1720.     sta    (pndptr),y
  1721.     ldy    #0        ; idx into name string
  1722. ppndev:
  1723.     ldx    #':        ; do we have a colon?
  1724.     jsr    pnfindc
  1725.     bmi    ppndev9        ; nope, skip this part
  1726.     lda    #pnf.dp        ; flag to set if we do it
  1727.     sta    ppncpf
  1728.     ldy    #0        ; start at zero please
  1729.     lda    #pnd.dm        ; do device component
  1730.     jsr    ppncomp
  1731.     jmp    ppnnam        ; go do the name
  1732. ppndev9:
  1733.     ldy    #0        ; reset string ptr
  1734. ppnnam:
  1735.     lda    #pnf.np        ; flag to set if we do it
  1736.     sta    ppncpf
  1737.     lda    #pnd.nm        ; do name component
  1738.     ldx    #'.        ; stop at dot
  1739.                 ; y's already set
  1740.     jsr    ppncomp
  1741.     lda    #pnf.ep        ; flag to set if we do it
  1742.     sta    ppncpf
  1743.     lda    #pnd.em        ; extension, please
  1744.     ldx    #ATEOL        ; sort of irrelevant, as we'll stop
  1745.                 ;  on any illegal char.
  1746.     jsr    ppncomp        ; y's already set.
  1747.     lda    ppncf        ; now put in accumulated flags
  1748.     ldy    #pnd.fl
  1749.     sta    (pndptr),y
  1750. ;zzz debug
  1751. ;    ldx    #ppndbg2\
  1752. ;    ldy    #ppndbg2^
  1753. ;    jsr    pstrnul
  1754. ;zzz
  1755.     rts            ; done!
  1756. ;
  1757. ;    pn2str:        (parsed) pathname to string.
  1758. ;            expects a pathname descriptor in (pndptr)
  1759. ;            and a string in X,Y.  Generates a namestring
  1760. ;            terminated by ATEOL, suitable for passing to
  1761. ;            CIO.  Note that it wants a fully qualified
  1762. ;            parsed pathname.
  1763. ;ppndbg3: .byte    "Enter pn2str",ATEOL,0
  1764. ;ppndbg4: .byte    "Leave pn2str",ATEOL,0
  1765. ;
  1766. ; this pushes one byte into output string
  1767. ;
  1768. pn2sp:
  1769.     sty    ppnt2        ; save y value for a bit
  1770.     ldy    ppnt0        ; get string idx
  1771.     sta    (pnptr),y    ; shove the char
  1772. ;zzz debug
  1773. ;    pha            ; save a
  1774. ;    txa            ; save x
  1775. ;    pha
  1776. ;    lda    (pnptr),y    ; get char back
  1777. ;    pha
  1778. ;    lda    #'|
  1779. ;    jsr    prchr
  1780. ;    pla
  1781. ;    jsr    prchr
  1782. ;    pla
  1783. ;    tax
  1784. ;    pla
  1785. ;zzz
  1786.     inc    ppnt0        ; bump the str idx
  1787.     ldy    ppnt2        ; get y back
  1788.     rts
  1789. ;
  1790. ; copy one component into outgoing string.
  1791. ; y contains offset into desc for component text, x contains size
  1792. ;
  1793. pn2scs:
  1794.     lda    (pndptr),y    ; get a char
  1795.     jsr    pn2sp        ; stuff it
  1796.     iny            ; bump dev text idx
  1797.     dex            ; dec size
  1798.     bne    pn2scs        ; back for more
  1799.     rts
  1800. ;
  1801. ; this inits regs, given an initial offset into the descriptor.
  1802. ; returns Z if length 0.
  1803. ;
  1804. pn2sin:
  1805.     lda    (pndptr),y    ; get the component size
  1806. ;zzz debug
  1807. ;    pha
  1808. ;    tya
  1809. ;    pha
  1810. ;    lda    #'#
  1811. ;    jsr    prchr
  1812. ;    pla            ; y val
  1813. ;    pha
  1814. ;    jsr    prbyte
  1815. ;    pla
  1816. ;    pha
  1817. ;    tay
  1818. ;    lda    (pndptr),y
  1819. ;    jsr    prbyte
  1820. ;    pla
  1821. ;    tay
  1822. ;    pla
  1823. ;zzz    
  1824.     iny            ; point y at text
  1825.     tax            ; save it as a counter, set Z for return
  1826.     rts
  1827. ;
  1828. ;    the main routine
  1829. ;
  1830. pn2str:
  1831.     stx    pnptr        ; set pathname string lo
  1832.     sty    pnptr+1        ;  and hi
  1833. ;zzz debug
  1834. ;    ldx    #ppndbg3\
  1835. ;    ldy    #ppndbg3^
  1836. ;    jsr    pstrnul
  1837. ;    lda    pnptr+1
  1838. ;    jsr    prbyte
  1839. ;    lda    pnptr
  1840. ;    jsr    prbyte
  1841. ;zzz
  1842.     ldy    #0        ; string idx
  1843.     sty    ppnt0
  1844.     ldy    #pnd.ds        ; dev component size
  1845.     jsr    pn2sin        ; set up regs
  1846.     beq    pn2str1        ; No dev???  ok, skip it
  1847.     jsr    pn2scs        ; copy a string
  1848.     lda    #':        ; get a colon
  1849.     jsr    pn2sp        ; push it in
  1850. ;
  1851. pn2str1:
  1852.     ldy    #pnd.ns        ; name component size
  1853.     jsr    pn2sin        ; set up
  1854.     beq    pn2str2        ; zero length name?? this should error ...
  1855.     jsr    pn2scs        ; copy it in
  1856. ;
  1857. pn2str2:
  1858.     lda    #'.        ; get a dot
  1859.     jsr    pn2sp        ; push it in
  1860. ;
  1861.     ldy    #pnd.es        ; name component size
  1862.     jsr    pn2sin
  1863.     beq    pn2str3        ; zero length ext?
  1864.     jsr    pn2scs        ; copy it in
  1865. pn2str3:
  1866.     lda    #ATEOL        ; get an eol
  1867.     jsr    pn2sp        ; push it in
  1868. ;zzz debug
  1869. ;    ldx    #ppndbg4\
  1870. ;    ldy    #ppndbg4^
  1871. ;    jsr    pstrnul
  1872. ;zzz
  1873.     rts            ; done!!!
  1874. ;
  1875. ;    pnmerge::    Merge two pathnames.  Move components from the
  1876. ;            first into missing components of the second, ie
  1877. ;        merge "D1:FOO.BAR","CRUD.BAZ" -> "D1:CRUD.BAZ"
  1878. ;
  1879. ;    wants pnddef pointing at pn1, pndptr at pn2
  1880. ;
  1881. pnmc:
  1882.     lda    (pndptr),y    ; get component size in target pathname
  1883.     bne    pnmc9        ; nonzero, try next
  1884.     lda    (pnddef),y    ; ok, get the one we're merging from
  1885.     beq    pnmc9        ; this one zero too?? ok, skip it
  1886.     tax            ; get size in x
  1887.     inx            ; inc to include size byte
  1888. pnmc1:
  1889.     lda    (pnddef),y    ; get a byte
  1890.     sta    (pndptr),y    ; put it in target
  1891.     iny            ; bump component ptr
  1892.     dex            ; dec count
  1893.     bne    pnmc1        ; round again
  1894. pnmc9:
  1895.     rts            ; done with this component
  1896.  
  1897. ;ppndbg5: .byte    "Enter pnmerge",ATEOL,0
  1898. ;ppndbg6: .byte    "Leave pnmerge",ATEOL,0
  1899.  
  1900. pnmerge:
  1901. ;zzz debug
  1902. ;    ldx    #ppndbg5\
  1903. ;    ldy    #ppndbg5^
  1904. ;    jsr    pstrnul
  1905. ;zzz
  1906.     ldy    #pnd.ds        ; look at dev component size
  1907.     jsr    pnmc        ; merge this component
  1908.     ldy    #pnd.ns        ; do name
  1909.     jsr    pnmc        ;  ...
  1910.     ldy    #pnd.es        ; and extension
  1911.     jsr    pnmc
  1912. ;zzz debug
  1913. ;    ldx    #ppndbg6\
  1914. ;    ldy    #ppndbg6^
  1915. ;    jsr    pstrnul
  1916. ;zzz
  1917.     rts            ; done!    
  1918. ;
  1919. ;
  1920. ;-----------------------------------------------------------------
  1921. ;
  1922.  
  1923. ;.SBTTL    Flag definitions
  1924.  
  1925. ;    The following are flags passed in the Y register
  1926.  
  1927. cmfehf    =    1        ;[EL] Extra help available
  1928. cmfdff    =    2        ;[EL] Default value present
  1929.  
  1930. ;.SBTTL    Parse types
  1931.  
  1932. ;    The following are different items to parse for
  1933.  
  1934. cmini    =    0        ; Token to indicate parser init
  1935. cmkey    =    1        ; Token to parse for keyword
  1936. cmifi    =    2        ; Token to parse for input file
  1937. cmofi    =    3        ; Token to parse for output file
  1938. cmcfm    =    4        ; Token to parse for confirm
  1939. cmnum    =    5        ; Token to parse for a number
  1940. cmswi    =    6        ; Token to parse for a switch
  1941. cmfls    =    7        ; Token to parse for a floating-point number
  1942. cmtxt    =    8        ; Token to parse for an unquoted string
  1943. cmtok    =    9        ; Token to parse for a single char token
  1944.  
  1945. ;.SBTTL    COMND package entry points
  1946.  
  1947. ;
  1948. ;    The following addresses are locations in a jump table which
  1949. ;    dispatch to appropriate routines in the Comnd package.
  1950. ;
  1951.  
  1952. mul16    =    comnd+3        ; 16-bit multiply routine
  1953. prcrlf    =    mul16+3        ; Routine to print a crelf
  1954. prstr    =    prcrlf+3    ; Routine to print an ASCIZ string
  1955. rskp    =    prstr+3        ; Routine to skip 3 bytes on return
  1956. setbrk    =    rskp+3        ; Routine to set a break char in brkwrd
  1957. rstbrk    =    setbrk+3    ; Routine to reset break char in brkwrd
  1958.  
  1959. .SBTTL    COMND JSYS routines
  1960.  
  1961. ;
  1962. ;    The following set of routines provides a user oriented way of parsing
  1963. ;    commands. It is similar to that of the COMND JSYS in TOPS-20. For
  1964. ;    convenience, a dispatch table is used.
  1965. ;
  1966.  
  1967. comnd:  jmp    comand        ;  Dispatch to main command routine
  1968.     jmp    ml16        ;  Dispatch to 16-bit multiply routine
  1969.     jmp    prcl.0        ;  Dispatch to Prcrlf
  1970.     jmp    prst.0        ;  Dispatch to Prstr
  1971.     jmp    rskp.0        ;  Dispatch to Rskp
  1972.     jmp    sbrk.0        ;  Dispatch to Setbrk
  1973.     jmp    rbrk.0        ;  Dispatch to Rstbrk
  1974.  
  1975. .SBTTL      Storage Declarations
  1976.  
  1977. ;
  1978. ;    Following is the storage decalarations for the Comnd routines
  1979. ;
  1980.  
  1981. ;cmbuf:  .blkb    $100        ; Input command buffer
  1982. cmbuf    =    scrmemlo    ; why not?
  1983. ;atmbuf:    .blkb    $100        ; Atombuffer, (for cmtxt and cmifil)
  1984. atmbuf    =    scrmemlo+$100
  1985. lenabf:    .byte            ; Length of atom in Atombuffer
  1986. brkwrd:    .blkb    $16        ; Break mask
  1987. savea:  .byte            ;
  1988. savex:  .byte            ;
  1989. savey:  .byte            ;
  1990. cmbase: .byte            ; Base of integer to be parsed
  1991. cmmres: .blkb    4        ; Return value from cmmult call
  1992. cmintg: .blkb    4        ; Return value for cminum call
  1993. cmfltp: .blkb    6        ; Return value for cmflot call
  1994. cmflen: .byte            ; Field length
  1995. ;cmcdrv: .byte            ; Current drive
  1996. cmostp: .word            ; Save area for stack pointer
  1997. cmrprs: .word            ; Reparse address
  1998. cmaflg: .byte            ; Non-zero when an action char has been found
  1999. cmcffl:    .byte            ; Non-Zero when previous command failed
  2000. cmfrcf:    .byte            ; Non-Zero when signif char has been seen
  2001. cmccnt: .byte            ; Non-zero if a significant char is found
  2002. cmocnt:    .byte            ; Saved length of command buffer
  2003. cmoptr:    .word            ; Saved ptr to command buffer for <ctrl/H>
  2004. cmsflg: .byte            ; Non-zero when the last char was a space
  2005. cmstat: .byte            ; Save area for parse type
  2006. cmprmx:    .byte            ; Hold area for Comnd parameters
  2007. cmprmy:    .byte            ; Hold area for Comnd flags
  2008. cmkyln: .byte            ; Keyword length
  2009. cmtlen: .byte            ; Test length (for ?-prompting)
  2010. cmscrs: .byte            ; Screen output switch
  2011. cmentr: .byte            ; Number of remaining entries in table
  2012. cmehix:    .byte            ; Index to extra help command buffer
  2013. keylen: .byte            ; Keyword length
  2014. cmwrk1: .byte            ; Command processing scratch area
  2015. cmwrk2: .byte            ;
  2016. cmwrk3: .byte            ;
  2017. cmwrk4: .byte            ;
  2018.  
  2019. ;----------------------------------------------------------------
  2020. ; Misc Atari support added here by jrd
  2021. ;
  2022.  
  2023. ;
  2024. ;    The new keyboard driver.
  2025. ;    This keyboard stuff is here because of two problems with the
  2026. ;    builtin K: driver; it can't generate all keycodes (the lack of
  2027. ;    a null is especially annoying) and there's no good way to get
  2028. ;    it to generate function key sequences.
  2029. ;    This stuff fixes both those things.  It's also arranged so that 
  2030. ;    returns ascii (not ATASCII) codes for everything.
  2031. ;
  2032. ;    Function key code equates.
  2033. ;
  2034. fnkurw    =    $80        ; up arrow
  2035. fnkdrw    =    $81        ; down arrow
  2036. fnklrw    =    $82        ; left arrow
  2037. fnkrrw    =    $83        ; right arrow
  2038. fnkpf1    =    $84        ; PF1
  2039. fnkpf2    =    $85
  2040. fnkpf3    =    $86
  2041. fnkpf4    =    $87
  2042. fnkk0    =    $88        ; keypad 0
  2043. fnkk1    =    $89
  2044. fnkk2    =    $8A
  2045. fnkk3    =    $8B
  2046. fnkk4    =    $8C
  2047. fnkk5    =    $8D
  2048. fnkk6    =    $8E
  2049. fnkk7    =    $8F
  2050. fnkk8    =    $90
  2051. fnkk9    =    $91
  2052. fnkkdot    =    $92        ; keypad dot
  2053. fnkkmin    =    $93        ; keypad minus
  2054. fnkkcom    =    $94        ; comma
  2055. fnkkent    =    $95        ; enter
  2056. ;
  2057. ; Special functions, handled internally
  2058. ;
  2059. fnksusp =    $C0        ; Suspend
  2060. fnkcpsl    =    $C1        ; Caps lock
  2061. fnkcpul    =    $C2        ; Caps unlock
  2062. ;
  2063. ;    The keypress to char translate table. Data for this is from OS man
  2064. ;    page 50.
  2065. ;
  2066. ;    The control-shift section of this table is used to generate
  2067. ;    function keys for VT100 emulation.  Character value is the
  2068. ;    function key code, above
  2069. ;
  2070. keyxl:
  2071. ; control = 0, shift = 0
  2072.     .byte    'l        ; (00)
  2073.     .byte    'j
  2074.     .byte    ';
  2075.     .byte    $FF        ; not used
  2076.     .byte    $FF        ; not used
  2077.     .byte    'k
  2078.     .byte    '+
  2079.     .byte    '*
  2080.     .byte    'o        ; (08)
  2081.     .byte    $FF        ; not used
  2082.     .byte    'p
  2083.     .byte    'u
  2084.     .byte    cr        ; NB! ascii cr, not ATEOL
  2085.     .byte    'i
  2086.     .byte    '-
  2087.     .byte    '=
  2088.     .byte    'v        ; (10)
  2089.     .byte    $FF        ; not used
  2090.     .byte    'c
  2091.     .byte    $FF        ; not used
  2092.     .byte    $FF        ; not used
  2093.     .byte    'b
  2094.     .byte    'x
  2095.     .byte    'z
  2096.     .byte    '4        ; (18)
  2097.     .byte    $FF        ; not used
  2098.     .byte    '3
  2099.     .byte    '6
  2100.     .byte    $1B
  2101.     .byte    '5
  2102.     .byte    '2
  2103.     .byte    '1
  2104.     .byte    ',        ; (20)
  2105.     .byte    $20
  2106.     .byte    '.
  2107.     .byte    'n
  2108.     .byte    $FF        ; not used
  2109.     .byte    'm
  2110.     .byte    '/
  2111.     .byte    fnksusp        ; atari key
  2112.     .byte    'r        ; (28)
  2113.     .byte    $FF        ; not used
  2114.     .byte    'e
  2115.     .byte    'y
  2116.     .byte    $09        ; tab.  Use ascii tab here
  2117.     .byte    't
  2118.     .byte    'w
  2119.     .byte    'q
  2120.     .byte    '9        ; (30)
  2121.     .byte    $FF        ; not used
  2122.     .byte    '0
  2123.     .byte    '7
  2124.     .byte    $7F        ; backspace. use ascii rubout
  2125.     .byte    '8
  2126.     .byte    '<
  2127.     .byte    '>
  2128.     .byte    'f        ; (38)
  2129.     .byte    'h
  2130.     .byte    'd
  2131.     .byte    $FF        ; not used
  2132.     .byte    fnkcpul        ; caps
  2133.     .byte    'g
  2134.     .byte    's
  2135.     .byte    'a
  2136. ; control = 0, shift = 1
  2137.     .byte    'L        ; (40)
  2138.     .byte    'J
  2139.     .byte    ':
  2140.     .byte    $FF        ; not used
  2141.     .byte    $FF        ; not used
  2142.     .byte    'K
  2143.     .byte    '\        ; sh-+
  2144.     .byte    '^        ; sh-*
  2145.     .byte    'O        ; (48)
  2146.     .byte    $FF        ; not used
  2147.     .byte    'P
  2148.     .byte    'U
  2149.     .byte    ATEOL        ; zzz maybe cr here?
  2150.     .byte    'I
  2151.     .byte    '_        ; sh--
  2152.     .byte    '|        ; sh-=
  2153.     .byte    'V        ; (50)
  2154.     .byte    $FF        ; not used
  2155.     .byte    'C
  2156.     .byte    $FF        ; not used
  2157.     .byte    $FF        ; not used
  2158.     .byte    'B
  2159.     .byte    'X
  2160.     .byte    'Z
  2161.     .byte    '$        ; (18) sh-4
  2162.     .byte    $FF        ; not used
  2163.     .byte    '#        ; sh-3
  2164.     .byte    '&        ; sh-6
  2165.     .byte    $1B        ; shift esc???
  2166.     .byte    '%        ; sh-5
  2167.     .byte    '"        ; sh-2
  2168.     .byte    '!        ; sh-1
  2169.     .byte    '[        ; (20)    sh-,
  2170.     .byte    $20        ; shift space?
  2171.     .byte    ']        ; sh-.
  2172.     .byte    'N
  2173.     .byte    $FF        ; not used
  2174.     .byte    'M
  2175.     .byte    '?        ; sh-/
  2176.     .byte    fnksusp        ; atari key
  2177.     .byte    'R        ; (68)
  2178.     .byte    $FF        ; not used
  2179.     .byte    'E
  2180.     .byte    'Y
  2181.     .byte    $09        ; tab.  Use ascii tab here
  2182.     .byte    'T
  2183.     .byte    'W
  2184.     .byte    'Q
  2185.     .byte    '(        ; (70) sh-9
  2186.     .byte    $FF        ; not used
  2187.     .byte    ')        ; sh-0
  2188.     .byte    ''        ; sh-7
  2189.     .byte    '~        ; backspace. Use this for tilde
  2190.     .byte    '@        ; sh-8
  2191.     .byte    '{        ; shift <
  2192.     .byte    '}        ; shift >
  2193.     .byte    'F        ; (78)
  2194.     .byte    'H
  2195.     .byte    'D
  2196.     .byte    $FF        ; not used
  2197.     .byte    fnkcpsl        ; shift caps
  2198.     .byte    'G
  2199.     .byte    'S
  2200.     .byte    'A
  2201. ; control = 1, shift = 0
  2202.     .byte    $0C        ; (80)    c-l
  2203.     .byte    $0A        ; c-j
  2204.     .byte    ';        ; ???
  2205.     .byte    $FF        ; not used
  2206.     .byte    $FF        ; not used
  2207.     .byte    $0B        ; c-k
  2208.     .byte    $1C        ; c-+ -> c-\
  2209.     .byte    $1E        ; c-* -> c-^
  2210.     .byte    $0F        ; (88) c-o
  2211.     .byte    $FF        ; not used
  2212.     .byte    $10        ; c-p
  2213.     .byte    $15        ; c-u
  2214.     .byte    ATEOL        ; zzz maybe cr here?
  2215.     .byte    $09        ; c-i
  2216.     .byte    $1F        ; c-- -> c-_
  2217.     .byte    $1D        ; c-= -> c-]
  2218.     .byte    $16        ; (90)    c-v
  2219.     .byte    $FF        ; not used
  2220.     .byte    $03        ; c-c
  2221.     .byte    $FF        ; not used
  2222.     .byte    $FF        ; not used
  2223.     .byte    $02        ; c-b
  2224.     .byte    $18        ; c-x
  2225.     .byte    $1A        ; c-z
  2226.     .byte    '4        ; (98) ???
  2227.     .byte    $FF        ; not used
  2228.     .byte    '3        ; ???
  2229.     .byte    '6        ; ???
  2230.     .byte    $1B        ; control esc?
  2231.     .byte    '5        ; ???
  2232.     .byte    '2        ; ???
  2233.     .byte    '1        ; ???
  2234.     .byte    ',        ; (A0)    ???
  2235.     .byte    $00        ; control sp
  2236.     .byte    '.        ; ???
  2237.     .byte    $0E        ; c-n
  2238.     .byte    $FF        ; not used
  2239.     .byte    cr        ; c-m
  2240.     .byte    '/        ; ???
  2241.     .byte    fnksusp        ; atari key
  2242.     .byte    $12        ; (A8)    c-r
  2243.     .byte    $FF        ; not used
  2244.     .byte    $05        ; c-e
  2245.     .byte    $19        ; c-y
  2246.     .byte    $09        ; tab.  Use ascii tab here
  2247.     .byte    $14        ; c-t
  2248.     .byte    $17        ; c-w
  2249.     .byte    $11        ; c-q
  2250.     .byte    '9        ; (B0) ???
  2251.     .byte    $FF        ; not used
  2252.     .byte    '0        ; ???
  2253.     .byte    $60        ; ^7 -> backquote
  2254.     .byte    $60        ; ^backspace -> backquote
  2255.     .byte    '8        ; ???
  2256.     .byte    $1B        ; ^< -> esc
  2257.     .byte    '>        ; ???
  2258.     .byte    $06        ; (B8)    c-f
  2259.     .byte    $08        ; c-h
  2260.     .byte    $04        ; c-d
  2261.     .byte    $FF        ; not used
  2262.     .byte    fnkcpul        ; caps
  2263.     .byte    bel        ; c-g
  2264.     .byte    $13        ; c-s
  2265.     .byte    $01        ; c-a
  2266. ; control = 1, shift = 1
  2267.     .byte    'l        ; (C0)
  2268.     .byte    'j
  2269.     .byte    ';
  2270.     .byte    $FF        ; not used
  2271.     .byte    $FF        ; not used
  2272.     .byte    'k
  2273.     .byte    fnklrw        ; c-sh-+ -> left arrow
  2274.     .byte    fnkrrw        ; c-sh-* -> right arrow
  2275.     .byte    'o        ; (08)
  2276.     .byte    $FF        ; not used
  2277.     .byte    'p
  2278.     .byte    'u
  2279.     .byte    fnkkent        ; c-sh-ret -> keypad enter
  2280.     .byte    'i
  2281.     .byte    fnkurw        ; c-sh-- -> up arrow
  2282.     .byte    fnkdrw        ; c-sh-= -> down arrow
  2283.     .byte    fnkkent        ; (10) c-sh-v -> enter
  2284.     .byte    $FF        ; not used
  2285.     .byte    fnkk3        ; c-sh-c -> kp3
  2286.     .byte    $FF        ; not used
  2287.     .byte    $FF        ; not used
  2288.     .byte    'b
  2289.     .byte    fnkk2        ; c-sh-x -> kp2
  2290.     .byte    fnkk1        ; c-sh-z -> kp1
  2291.     .byte    fnkk4        ; (18) c-sh-4
  2292.     .byte    $FF        ; not used
  2293.     .byte    fnkk3        ; c-sh-3
  2294.     .byte    fnkk6        ; c-sh-6
  2295.     .byte    $1B
  2296.     .byte    fnkk5        ; c-sh-5
  2297.     .byte    fnkk2        ; c-sh-2
  2298.     .byte    fnkk1        ; c-sh-1
  2299.     .byte    fnkkcom        ; (E0) c-sh-comma
  2300.     .byte    fnkk0        ; c-sh-space -> keypad 0
  2301.     .byte    fnkkdot        ; c-sh-.
  2302.     .byte    'n
  2303.     .byte    $FF        ; not used
  2304.     .byte    'm
  2305.     .byte    '/
  2306.     .byte    fnksusp        ; atari key
  2307.     .byte    fnkpf4        ; (E8) c-sh-r -> pf4
  2308.     .byte    $FF        ; not used
  2309.     .byte    fnkpf3        ; c-sh-e
  2310.     .byte    'y
  2311.     .byte    $09        ; tab.  Use ascii tab here
  2312.     .byte    't
  2313.     .byte    fnkpf2        ; c-sh-w
  2314.     .byte    fnkpf1        ; c-sh-q
  2315.     .byte    fnkk9        ; (F0) c-sh-9
  2316.     .byte    $FF        ; not used
  2317.     .byte    fnkk0        ; c-sh-0
  2318.     .byte    fnkk7        ; c-sh-7
  2319.     .byte    $08        ; backspace. use ascii backspace?
  2320.     .byte    fnkk8        ; c-sh-8
  2321.     .byte    fnklrw        ; c-sh-< left arrow
  2322.     .byte    fnkrrw        ; c-sh-> right arrow
  2323.     .byte    fnkkmin        ; (F8)
  2324.     .byte    'h
  2325.     .byte    fnkk6        ; c-sh-d kp6
  2326.     .byte    $FF        ; not used
  2327.     .byte    fnkcpsl        ; caps
  2328.     .byte    'g
  2329.     .byte    fnkk5        ; c-sh-s kp5
  2330.     .byte    fnkk4        ; c-sh-a kp4
  2331. ;
  2332. ; the code that uses the above table.
  2333. ;
  2334. ;    kbdget    -    get a char from keyboard, if any waiting.
  2335. ;            returns char in A
  2336. ;            returns Carry clear if got char, set if not
  2337. ;
  2338. kbdget:    lda    CH
  2339.     cmp    #$FF        ; no char pending?
  2340.     beq    kbdnone        ; nope, give up
  2341.     tax            ; get char in x
  2342.     lda    keyxl,x        ; translate it
  2343. ;
  2344. ; if >= $C0, handled internally, don't return anything
  2345. ;
  2346.     pha
  2347.     and    #$C0        ; mask to 2 hi bits
  2348.     tax            ; save that
  2349.     pla            ; get original back
  2350.     cpx    #$C0        ; internal code?
  2351.     beq    kbdspec        ; yes, handle specially
  2352.     clc
  2353.     jmp    kbdret        ; no, go return this one
  2354. kbdspec:
  2355.     cmp    #fnksusp    ; suspend?
  2356.     bne    kbdspec1    ; nope, ignore it
  2357.     lda    suspend        ; it is; toggle suspend flag
  2358.     eor    #$01
  2359.     sta    suspend
  2360.     jmp    kbdupds
  2361. kbdspec1:
  2362.     cmp    #fnkcpsl    ; caps lock?
  2363.     bne    kbdspec2    ; nope
  2364.     lda    #1
  2365.     sta    capslck        ; lock on
  2366.     jmp    kbdupds        ; update stat line
  2367. kbdspec2:
  2368.     cmp    #fnkcpul    ; caps unlock?
  2369.     bne    kbdnone        ; nope
  2370.     lda    #0
  2371.     sta    capslck        ; lock off
  2372. kbdupds:
  2373.     jsr    updstat        ; update stat line
  2374. kbdnone:
  2375.     sec            ; nope, none here
  2376.     lda    #0
  2377. kbdret:
  2378.     ldx    #$FF        ; zap CH
  2379.     stx    CH
  2380.     bcs    kbd999        ; if no char, just go home
  2381.     cmp    #0        ; function key?
  2382.     bmi    kbd998
  2383.     ldx    capslck        ; caps lock on?
  2384.     beq    kbd998        ; nope, return as is
  2385.     jsr    pncupc        ; borrow pathname rtn
  2386. kbd998:    clc            ; make sure carry clr
  2387. kbd999:    rts            ; and go home with it
  2388.  
  2389. ;
  2390. ;    Function key tables.  All these are 4 bytes long, zero padded,
  2391. ;    for ease of indexing
  2392. ;
  2393. vt100fk:
  2394.     .byte    "[A",0,0    ; up
  2395.     .byte    "[B",0,0    ; down
  2396.     .byte    "[D",0,0    ; left
  2397.     .byte    "[C",0,0    ; right
  2398.     .byte    "OP",0,0    ; pf1
  2399.     .byte    "OQ",0,0
  2400.     .byte    "OR",0,0
  2401.     .byte    "OS",0,0
  2402.     .byte    "Op",0,0    ; kp0
  2403.     .byte    "Oq",0,0
  2404.     .byte    "Or",0,0
  2405.     .byte    "Os",0,0
  2406.     .byte    "Ot",0,0
  2407.     .byte    "Ou",0,0
  2408.     .byte    "Ov",0,0
  2409.     .byte    "Ow",0,0
  2410.     .byte    "Ox",0,0
  2411.     .byte    "Oy",0,0    ; kp9
  2412.     .byte    "On",0,0    ; kp.
  2413.     .byte    "Om",0,0    ; kp-
  2414.     .byte    "Ol",0,0    ; kp,
  2415.     .byte    "OM",0,0    ; enter
  2416. vt52fk:
  2417. ; fill in later
  2418.  
  2419. ;
  2420. ;    fksend:        send an escape seq in terminal mode
  2421. ;            Code in A
  2422. ;            pointer to fk table in x,y
  2423. ;
  2424. fksend:
  2425.     stx    strptr        ; set up pointer to esc data
  2426.     sty    strptr+1
  2427.     and    #$1F        ; trim hi bits
  2428.     asl    A
  2429.     asl    A        ; * 4
  2430.     tay            ; get idx in y
  2431.     lda    #$1B        ; send an escape
  2432.     jsr    putrs
  2433. fksend1:
  2434.     lda    (strptr),y    ; get a char
  2435.     beq    fksend9
  2436.     jsr    putrs        ; send it
  2437.     iny
  2438.     jmp    fksend1        ; round again
  2439. fksend9:
  2440.     rts            ; done!
  2441. ;
  2442. ; end of new kbd code
  2443. ;
  2444.  
  2445. ;
  2446. ; Other handy IO routines
  2447. ;
  2448.  
  2449. ;
  2450. ;    Zap ax1, ax2
  2451. ;
  2452. iozax:    lda    #0
  2453.     sta    ICAX1,X
  2454.     sta    ICAX2,X
  2455.     rts
  2456. ;
  2457. ;    Set BA
  2458. ;
  2459. iosba:    sta    ICBAL,X
  2460.     tya
  2461.     sta    ICBAH,X
  2462.     rts
  2463. ;
  2464. ;    Set BL
  2465. ;
  2466. iosbl:    sta    ICBLL,X
  2467.     tya
  2468.     sta    ICBLH,X
  2469.     rts
  2470. ;
  2471. ; Read a char from IOCB in X
  2472. ;
  2473. chrin:    lda    #GETCHR        ; get raw bytes
  2474.     sta    ICCOM,X        ; in command code
  2475.     lda    #0
  2476.     tay
  2477.     jsr    iosba
  2478.     jsr    iosbl
  2479.     jsr    CIOV        ; go do it
  2480.     rts
  2481. ;
  2482. ; Write a char (in A) to port in X
  2483. ;
  2484. chrout:    pha            ; save the char
  2485.     lda    #PUTCHR        ; put raw bytes
  2486.     sta    ICCOM,X        ; in command code
  2487.     lda    #0
  2488.     tay
  2489.     jsr    iosba
  2490.     jsr    iosbl
  2491.     pla            ; get the char back
  2492.     jsr    CIOV        ; go do it
  2493.     rts
  2494. ;
  2495. ; OPEN a stream; iocb in X, name in A,Y.  Mode already set
  2496. ; return status in Y
  2497. ;
  2498. openiocb:
  2499.     jsr    iosba
  2500.     lda    #OPEN        ; open command
  2501.     sta    ICCOM,X        ; stuff it in
  2502.     lda    #0        ; zap buf len
  2503.     sta    ICBLL,X
  2504.     sta    ICBLH,X
  2505.     jmp    CIOV        ; go do it
  2506. ;
  2507. ; Open for input.  IOCB in X, name in A,Y
  2508. ;
  2509. opencin:
  2510.     pha            ; save name lo
  2511.     lda    #OPNIN        ; get input code
  2512.     sta    ICAX1,X        ; shove in aux 1
  2513.     lda    #0        ; clear 
  2514.     sta    ICAX2,X        ; aux2
  2515.     pla            ; get name ptr back
  2516.     jmp    openiocb    ; go open it
  2517. ;
  2518. ; Similar one for output
  2519. ;
  2520. opencout:
  2521.     pha            ; save name lo
  2522.     lda    #OPNOT        ; get output code
  2523.     sta    ICAX1,X        ; shove in aux 1
  2524.     lda    #0        ; clear 
  2525.     sta    ICAX2,X        ; aux2
  2526.     pla            ; get name ptr back
  2527.     jmp    openiocb    ; go open it
  2528. ;
  2529. ; Similar one for io
  2530. ;
  2531. opencio:
  2532.     pha            ; save name lo
  2533.     lda    #OPNINO        ; get IO code
  2534.     sta    ICAX1,X        ; shove in aux 1
  2535.     lda    #0        ; clear 
  2536.     sta    ICAX2,X        ; aux2
  2537.     pla            ; get name ptr back
  2538.     jmp    openiocb    ; go open it
  2539. ;
  2540. ; And one for dirlists
  2541. ;
  2542. opencdir:
  2543.     pha            ; save name lo
  2544.     lda    #OPNIN!DIRECT    ; get directory please
  2545.     sta    ICAX1,X        ; shove in aux 1
  2546.     lda    #0        ; clear 
  2547.     sta    ICAX2,X        ; aux2
  2548.     pla            ; get name ptr back
  2549.     jmp    openiocb    ; go open it
  2550. ;
  2551. ; Close IOCB, in X
  2552. ;
  2553. closec:
  2554.     lda    #CLOSE        ; close command code
  2555.     sta    ICCOM,X
  2556.     jmp    CIOV        ; go do it
  2557. ;
  2558. ; Open screen iocb to screen.
  2559. ;
  2560. openscr:
  2561.     ldx    #scrchan    ; screen iocb please
  2562.     cpx    #0        ; 0?
  2563.     beq    openscr9    ; yup, atari OS leaves 0 open to E:, so exit
  2564.     lda    #scrname\    ; E:
  2565.     ldy    #scrname^
  2566.     jsr    opencout    ; open for output.
  2567. openscr9:
  2568.     lda    SDLSTL        ; remember display list addr for when we change
  2569.     sta    scraedl
  2570.     lda    SDLSTH
  2571.     sta    scraedl+1
  2572.     rts
  2573. ;
  2574. ; Put a byte to the screen.  char in A.
  2575. ;
  2576. sputch:
  2577.     ldx    #scrchan
  2578.     jmp    chrout
  2579. ;
  2580. ; Out a string to screen, nul terminated.
  2581. ; string pointer in X,Y.  Uses strptr.  Saves all regs
  2582. ;
  2583.     .byte    0        ; temp for y
  2584. pstrnul:
  2585.     pha            ; Save A
  2586.     stx    strptr        ; store lo byte of pointer
  2587.     sty    strptr+1    ;  hi byte
  2588.     txa            ; save x
  2589.     pha
  2590.     tya            ; and y
  2591.     pha
  2592.     ldy    #0
  2593. pstrnul1:
  2594.     lda    (strptr),y    ; get a byte
  2595.     beq    pstrnul9    ; nul, go home
  2596.     sty    pstrnul-1    ; save y
  2597.     cmp    #ATEOL        ; special case these
  2598.     beq    pstrnul2
  2599.     and    #$7F        ; no reverse vid here
  2600.     cmp    #cr        ; special kludge for ascii cr
  2601.     bne    pstrnul2    ; nope, go ahead
  2602.     lda    #ATEOL        ; yup, substitute real EOL
  2603. pstrnul2:
  2604. ;    jsr    sputch        ; go put it out
  2605.     jsr    scrput        ; put it out, general case
  2606.     ldy    pstrnul-1    ; ignore status, get y back
  2607.     iny            ; bump to next char
  2608.     bne    pstrnul1    ; if zero...
  2609.     inc    strptr+1    ;  bump hi word of ptr
  2610.     jmp    pstrnul1
  2611. pstrnul9:
  2612.     pla            ; get y back
  2613.     tay
  2614.     pla            ; get x back
  2615.     tax
  2616.     pla            ; get A back
  2617.     rts            ; all done.
  2618.  
  2619. ;
  2620. ;    Pstreol        Simple-minded version for outputting 
  2621. ;            ATEOL terminated strings.  Doesn't print the EOL.
  2622. ;            string must be shorter than 256.
  2623. ;            Saves A, trashes X,Y
  2624. ;
  2625. pstreol:
  2626.     pha            ; save a
  2627.     stx    strptr        ; set string ptr
  2628.     sty    strptr+1
  2629.     ldy    #0        ; init idx
  2630. pstreol1:
  2631.     lda    (strptr),y    ; get a byte
  2632.     sty    pstrnul-1    ; use that temp, don't need another
  2633.     cmp    #ATEOL        ; eol?
  2634.     beq    pstreol9    ; yes, done
  2635. ;    jsr    sputch        ; out it
  2636.     jsr    scrput        ; put it out, general case
  2637.     ldy    pstrnul-1    ; get y back
  2638.     iny            ; bump
  2639.     bne    pstreol1    ; unless wrap, go back for more
  2640. pstreol9:
  2641.     pla            ; get a back
  2642.     rts            ; home!
  2643.     
  2644. ;
  2645. ;
  2646. ;----------------------------------------------------------------
  2647. ; 
  2648. .SBTTL    Prompt subroutine
  2649.  
  2650. ;
  2651. ;    This routine prints the prompt for the program and specifies the
  2652. ;    reparse address.
  2653. ;
  2654. ;        Inputs:        X - L.O. byte address of prompt
  2655. ;                Y - H.O. byte address of prompt
  2656. ;
  2657. ;        Outputs:
  2658. ;
  2659. ;        Registers destroyed:    A,X,Y
  2660. ;
  2661.  
  2662. prompt: pla            ; Get Low order byte of return address
  2663.     sta    cmrprs        ; Save that half of reparse address
  2664.     pla            ; Get High order byte
  2665.     sta    cmrprs+1    ; Save the half
  2666.     pha            ; Restore the return
  2667.     lda    cmrprs        ;  address to
  2668.     pha            ;    the stack
  2669.     clc            ; Clear the carry
  2670.     adc    #1        ; Increment this address since it is one
  2671.     sta    cmrprs        ;    short of the desired target.
  2672.     lda    cmrprs+1    ; Account for the carry, if any
  2673.     adc    #0        ;        ...
  2674.     sta    cmrprs+1    ;        ...
  2675.     stx    cm.rty        ; Save the address of the prompt in
  2676.     sty    cm.rty+1    ; pointer to the ctrl/r text
  2677.     tsx            ; Get the stack pointer
  2678.     stx    cmostp        ; Save it for later restoral
  2679.     lda    #cmbuf\        ; Get low order byte of buffer address
  2680.     sta    cm.bfp        ; Init start of text buffer
  2681.     sta    cm.ptr        ; Init next input to be parsed
  2682.     lda    #cmbuf^        ; Get high order byte of buffer address
  2683.     sta    cm.bfp+1    ; H.O. byte of text buffer pointer
  2684.     sta    cm.ptr+1    ; H.O. byte of next input pointer
  2685.     lda    #0        ; Clear AC
  2686.     sta    cmaflg        ; Clear the flags
  2687.     sta    cmccnt        ;
  2688.     sta    cmsflg        ;
  2689.     jsr    prcrlf        ; Print crlf
  2690.     ldx    cm.rty        ; Get L.O. byte of prompt address to be passed
  2691.     ldy    cm.rty+1    ; Get H.O. byte of prompt address
  2692.     jsr    prstr        ; Print the prompt
  2693.     rts            ; Return
  2694.  
  2695. .SBTTL    Repars routine
  2696.  
  2697. ;
  2698. ;    This routine sets stuff up to reparse the current command
  2699. ;    buffer.
  2700. ;
  2701. ;        Input:
  2702. ;
  2703. ;        Output:        Reinitialize comnd pointers and flags
  2704. ;
  2705. ;        Registers destroyed:    A,X
  2706. ;
  2707.  
  2708. repars: ldx    cmostp        ; Fetch old Stack pointer
  2709.     txs            ; Make it the current one
  2710.     lda    #cmbuf\        ; Get L.O. byte address of cmbuf
  2711.     sta    cm.ptr        ; Stuff it
  2712.     lda    #cmbuf^        ; Get H.O. byte address of cmbuf
  2713.     sta    cm.ptr+1    ; The buffer pointer is now reset
  2714.     lda    #0        ; Clear AC
  2715.     sta    cmsflg        ; Clear the space flag
  2716.     jmp    (cmrprs)    ; Jump at the reparse address
  2717.  
  2718. ;.SBTTL    Prserr routine
  2719.  
  2720. ;
  2721. ;    This routine is used when a parsing error occurs. It resets ALL
  2722. ;    of the pointers and flags and then goes to the reparse address.
  2723. ;
  2724. ;        Input:
  2725. ;
  2726. ;        Output:
  2727. ;
  2728. ;        Registers destroyed:
  2729. ;
  2730.  
  2731. prserr:    lda    cm.ptr        ; Store old command line pointer
  2732.     sta    cmoptr        ;        ...
  2733.     lda    cm.ptr+1    ;         ...
  2734.     sta    cmoptr+1    ;         ...
  2735.     lda    cmccnt        ; Store old character count
  2736.     sta    cmocnt        ;        ...
  2737.     lda    #$FF        ; Set the failure flag
  2738.     sta    cmcffl        ;        ...
  2739.     ldx    cmostp        ; Fetch the saved SP
  2740.     txs            ; Make it the current one
  2741.     lda    #cmbuf\        ; Set up the command buffer
  2742.     sta    cm.bfp        ;     address in both the
  2743.     sta    cm.ptr        ;     buffer pointer and the 
  2744.     lda    #cmbuf^        ;    next input pointer.
  2745.     sta    cm.bfp+1    ;        ...
  2746.     sta    cm.ptr+1    ;        ...
  2747.     lda    #0        ; Clear AC
  2748.     sta    cmaflg        ; Zero the action flag
  2749.     sta    cmccnt        ;    the character count
  2750.     sta    cmsflg        ;    and the space flag
  2751.     jsr    prcrlf        ; Print a crelf
  2752.     ldx    cm.rty        ;  Get the address of the prompt
  2753.     ldy    cm.rty+1    ;        ...
  2754.     jsr    prstr        ; Reprint the prompt
  2755.     jmp    (cmrprs)    ; Jump at the reparse address
  2756.  
  2757. .SBTTL    COMND - Entry point for command Jsys stuff
  2758.  
  2759. ;
  2760. ;    COMND routine - This routine checks the code in the AC for
  2761. ;    what parse type is wanted and then dispatches to an appropriate
  2762. ;    routine to look for it. Additional information is located in
  2763. ;    CMINF1 and CMINF2 on page zero.
  2764. ;
  2765. ;        Input:        A - parse type
  2766. ;                X,Y - optional parameters
  2767. ;
  2768. ;        Output:        A - +1 = success
  2769. ;                    +4 = failure (assumes JMP after call)
  2770. ;
  2771. ;        Registers destroyed:    A
  2772. ;
  2773.  
  2774. comand: sta    cmstat        ; Save what we are parsing
  2775.     stx    cmprmx        ; Save these parameters also
  2776.     sty    cmprmy        ;        ...
  2777.     cmp    #cmini        ; Initialize the world?
  2778.     bne    comn0        ; No, handle like a normal parse type
  2779.     jmp    prompt        ; Do the prompt routine to set things up
  2780. comn0:  jsr    cminbf        ; Get characters until action or erase
  2781.     cmp    #cmcfm        ; Parse a confirm?
  2782.     bne    comn1        ; Nope
  2783.     jmp    cmcfrm        ; Yes, try for the confirm
  2784. comn1:  cmp    #cmkey        ; Parse a keyword perhaps?
  2785.     bne    comn2        ; No, next item
  2786.     jmp    cmkeyw        ; Get the keyword
  2787. comn2:  cmp    #cmifi        ; Parse an input file?
  2788.     bne    comn3        ; No, try next one
  2789.     jmp    cmifil        ; Get the input file
  2790. comn3:  cmp    #cmofi        ; Parse an output file?
  2791.     bne    comn4        ; No, try next
  2792.     jmp    cmofil        ; Get the output file
  2793. comn4:  cmp    #cmswi        ; Parse a switch?
  2794.     bne    comn5        ; No, try next again
  2795.     jmp    cmswit        ; Yes, do a switch
  2796. comn5:  cmp    #cmnum        ; Parse an integer?
  2797.     bne    comn6        ; No, try next type
  2798.     jmp    cminum        ; Do the parse integer routine
  2799. comn6:  cmp    #cmfls        ; Parse a floating point?????
  2800.     bne    comn7        ; Nope, thats it for types
  2801.     jmp    cmflot        ; Yes, go get a floating point number
  2802. comn7:    cmp    #cmtxt        ;  Parse for an unquoted string?
  2803.     bne    comn8        ;  Nope, go try last type
  2804.     jmp    cmunqs        ;  Go parse the string
  2805. comn8:    cmp    #cmtok        ;  Parse for a single character?
  2806.     bne    comn9        ;  Nope, no more parse types
  2807.     jmp    cmtokn        ;  Go parse for char
  2808. comn9:  ldx    #cmer00\    ; Error 0 - Bad parse type
  2809.     ldy    #cmer00^
  2810.     jsr    prstr        ; Print the error text
  2811.     lda    #4        ; Fail
  2812.     rts            ; Return to caller
  2813.  
  2814. .SBTTL    Cmcfrm routine - get a confirm
  2815.  
  2816. ;
  2817. ;    This routine tries to get a confirm from the command input
  2818. ;    buffer.
  2819. ;
  2820. ;        Input:  Cm.ptr  - Beginning of next field to be parsed
  2821. ;
  2822. ;        Output: On success, routine skip returns
  2823. ;
  2824. ;        Registers destroyed:    A,X,Y
  2825. ;
  2826.  
  2827. cmcfrm: lda    cm.ptr        ; Save the current comand line pointer
  2828.     pha            ;    on the stack in case the user
  2829.     lda    cm.ptr+1    ;    wants to parse for an alternate item
  2830.     pha            ;
  2831. cmcfr0: jsr    cmgtch        ; Get a character
  2832.     cmp    #0        ; Is it negative?
  2833.     bpl    cmcfrr        ; No, fail
  2834.     and    #$7F        ; Yes, zero the sign bit
  2835.     cmp    #esc        ; An escape?
  2836.     bne    cmcfr2        ; No, continue
  2837.     jsr    bell        ; Sound bell, er
  2838.     lda    #0        ; Clear AC
  2839.     sta    cmaflg        ; Clear the action flag
  2840.     sec            ; Set carry for subtraction
  2841.     lda    cm.bfp        ; Get L.O. byte
  2842.     sbc    #1        ; Decrement it once
  2843.     sta    cm.bfp        ; Store it back
  2844.     sta    cm.ptr        ; Make this pointer look like the other one
  2845.     bcs    cmcfr1        ; If set, we don't have to do H.O. byte
  2846.     dec    cm.bfp+1    ; Adjust H.O. byte
  2847. cmcfr1: lda    cm.bfp+1    ; Move this to H.O. byte of the other pointer
  2848.     sta    cm.ptr+1
  2849.     dec    cmccnt        ; Decrement the character count
  2850.     jmp    cmcfr0        ; Try again.
  2851. cmcfr2: cmp    #'?        ; User need help??
  2852.     bne    cmcfr3        ; Nope
  2853.     jsr    cout        ; Print the '?'
  2854.     ldx    #cmin00\    ; Get address of some help info
  2855.     ldy    #cmin00^    ;
  2856.     jsr    prstr        ; Print it.
  2857.     jsr    prcrlf        ; Print the crelf
  2858.     ldx    cm.rty        ;  Get address of prompt
  2859.     ldy    cm.rty+1    ;
  2860.     jsr    prstr        ; Reprint the prompt
  2861.     lda    #0        ; Clear AC
  2862.     ldy    #0        ; Clear Y
  2863.     sta    (cm.ptr),y    ; Drop null at end of command buffer
  2864.     sec            ; Set carry for subtraction
  2865.     lda    cm.bfp        ; Get L.O. byte
  2866.     sbc    #1        ; Decrement it
  2867.     sta    cm.bfp        ; Store it back
  2868.     lda    cm.bfp+1    ; Now do H.O. byte
  2869.     sbc    #0        ;
  2870.     sta    cm.bfp+1    ;
  2871.     ldx    #cmbuf\        ; Get address of the command buffer
  2872.     ldy    #cmbuf^        ;
  2873.     jsr    prstr        ; Reprint the command line
  2874.     lda    #0        ; Clear AC
  2875.     sta    cmaflg        ; Action flag off
  2876.     jmp    repars        ; Go reparse the line
  2877. cmcfr3: cmp    #ffd        ; Is it a form feed?
  2878.     bne    cmcfr4        ; Nope
  2879.     jsr    scred2        ; Yes, blank the screen
  2880.     ldx    #0
  2881.     ldy    #0
  2882.     jsr    scrplt        ; and home the cursor
  2883. cmcfr4: pla            ; Since this succeeded, we can flush the
  2884.     pla            ;    old command line pointer
  2885.     lda    #0        ;  Reset the failure flag
  2886.     sta    cmcffl        ; 
  2887.     jmp    rskp        ; Do a return skip
  2888.  
  2889. cmcfrr: pla            ;  Restore the old comand line pointer
  2890.     sta    cm.ptr+1    ; 
  2891.     sta    cmoptr+1    ; 
  2892.     pla            ; 
  2893.     sta    cm.ptr        ; 
  2894.     sta    cmoptr        ; 
  2895.     lda    cmccnt        ;  Save count in case of <ctrl/H>
  2896.     sta    cmocnt        ; 
  2897.     lda    #$FF        ;  Set failure
  2898.     sta    cmcffl        ; 
  2899.     rts            ; Return
  2900.  
  2901. .SBTTL    Cmkeyw - Try to parse a keyword next
  2902.  
  2903. ;
  2904. ;    This routine tries to parse a keyword from the table
  2905. ;    pointed to by cminf1. The keywords must be in alphabetical
  2906. ;    order. The routine returns the two bytes of data associated
  2907. ;    with the keyword. The format of the table is as follows:
  2908. ;
  2909. ;    addr:    .byte    n    ; Where n is the # of entries in the table.
  2910. ;        .byte    m    ; m is the size of the next keyword
  2911. ;        .asciz  /string/; keyword ending in a null
  2912. ;        .byte    a,b    ; 16 bits of data related to keyword
  2913. ;
  2914. ;        Input:  Cminf1- Pointer to keyword table
  2915. ;
  2916. ;        Output: X-    byte a
  2917. ;            Y-    byte b
  2918. ;
  2919. ;        Registers destroyed:    A,X,Y
  2920. ;
  2921.  
  2922. cmkeyw: lda    cm.ptr        ; Save the old comand line pointer
  2923.     pha            ;
  2924.     lda    cm.ptr+1
  2925.     pha            ;
  2926.     lda    #0        ;  Clear the 'real character' flag
  2927.     sta    cmfrcf        ; 
  2928.     lda    cminf1        ; Copy to address of
  2929.     sta    cmptab        ;    the keyword table
  2930.     clc            ; Clear the carry
  2931.     adc    #1        ; Add one to the addr. (pass the table length)
  2932.     sta    cmkptr        ; Save the keyword pointer (L.O. byte)
  2933.     lda    cminf1+1    ; Get H.O. byte
  2934.     sta    cmptab+1    ; Save a copy of that
  2935.     bcc    cmkey1        ; Carry?
  2936.     adc    #0        ; Add in the carry for cmkptr
  2937. cmkey1: sta    cmkptr+1    ; Save it
  2938.     ldy    #0        ; Clear Y
  2939.     lda    (cmptab),y    ; Get the table length
  2940.     sta    cmentr        ; Save number of entries in the table
  2941. cmky10:    jsr    cmgtch        ; Get first character
  2942.     cmp    #0        ; Was the first character a terminator?
  2943.     bmi    cmky11        ; Yup, the saved pointer does not get decr.
  2944.     sec            ; Make sure saved buffer pointer is correct
  2945.     lda    cm.ptr        ; Now, reset it back one character for later
  2946.     sbc    #1        ;
  2947.     sta    cm.ptr        ;
  2948.     sta    cmsptr        ;
  2949.     lda    cm.ptr+1    ;
  2950.     sbc    #0        ;
  2951.     sta    cm.ptr+1    ;
  2952.     sta    cmsptr+1    ;
  2953.     jmp    cmkey2        ; Continue
  2954. cmky11: ldy    cm.ptr        ; Just move the pointer to the save area
  2955.     sty    cmsptr        ;
  2956.     ldy    cm.ptr+1    ;
  2957.     sty    cmsptr+1    ;
  2958.     and    #$7F        ;[EL] ????
  2959.     cmp    #esc        ;  Was the first terminator an escape?
  2960.     beq    cmky12        ;  Yes, handle this
  2961.     jmp    cmkey2        ;  No, continue
  2962. cmky12:    lda    #cmfdff        ;  Is there a default?
  2963.     bit    cmprmy        ;         ...
  2964.     bne    cmky13        ;  Yes, go copy it
  2965.     lda    #0        ;  Shut the action flag
  2966.     sta    cmaflg        ;         ...
  2967.     jsr    bell        ;  Yes, start by feeping terminal
  2968.     sec            ;  Set the carry bit for subtraction
  2969.     lda    cm.bfp        ;  Take L.O. byte of buffer pointer
  2970.     sbc    #1        ;  Decrement it (back up before escape)
  2971.     sta    cm.bfp        ;  Store it
  2972.     sta    cm.ptr        ;  And stuff it in next input char pointer
  2973.     bcs    cmkync        ;  If carry is clear, we are done
  2974.     dec    cm.bfp+1    ;  Do the carry on H.O. byte
  2975. cmkync:    lda    cm.bfp+1    ;  Copy this to next char to parse pointer
  2976.     sta    cm.ptr+1    ;         ...
  2977.     jmp    cmky10        ;  Continue by fetching a character again
  2978. cmky13:    lda    #0        ;  Zero the action flag
  2979.     sta    cmaflg        ;         ...
  2980.     jmp    cmcpdf        ;   Do the copy    
  2981. cmkey2: lda    cmentr        ; Get number of entries left
  2982.     cmp    #0        ; 0 entries left?
  2983.     bne    cmky21        ; No, go try next entry
  2984.     pla            ; Fetch back to previous comand line pointer
  2985.     sta    cm.ptr+1    ;        ...
  2986.     sta    cmoptr+1    ;        ...
  2987.     pla            ;        ...
  2988.     sta    cm.ptr        ;        ...
  2989.     sta    cmoptr        ;        ...
  2990.     lda    cmccnt        ; Save count in case of <ctrl/H>
  2991.     sta    cmocnt        ;        ...
  2992.     lda    #$FF        ; Set the command-failure flag
  2993.     sta    cmcffl        ;        ...
  2994.     rts
  2995. cmky21: ldy    #0        ; Clear Y
  2996.     lda    (cmkptr),y    ; Get length of keyword
  2997.     sta    keylen        ; Store it
  2998.     lda    cmkptr        ; Get the new table pointer
  2999.     sta    cmspt2        ;    and save it for later
  3000.     lda    cmkptr+1    ;        ...
  3001.     sta    cmspt2+1    ;        ...
  3002.     inc    cmkptr        ; Increment the L.O. byte once
  3003.     bne    cmkey3        ; If it didn't wrap, there is no carry
  3004.     inc    cmkptr+1    ; There was a carry, add it in.
  3005. cmkey3: dec    keylen        ; Decrement the number of chars. left
  3006.     lda    keylen        ; Get the remaining length
  3007.     cmp    #$FF        ; Have we passed the end
  3008.     bpl    cmk3a        ; No
  3009.     jmp    cmkey5        ; Yes
  3010. cmk3a:  jsr    cmgtch        ; Get a character
  3011.     cmp    #0        ; Is it a terminator?
  3012.     bmi    cmk3b        ; Yup, it is negative
  3013.     jmp    cmkey4        ; Nope, it's positive
  3014. cmk3b:  and    #$7F        ; Shut off the minus bit
  3015.     cmp    #'?        ; Need any help?
  3016.     bne    cmky31        ; Nope
  3017.     jsr    cout        ; And print the question mark
  3018.     lda    #0        ; Clear AC
  3019.     sta    cmaflg        ; Clear the action flag
  3020.     lda    cmstat        ; Get saved parse type
  3021.     cmp    #cmswi        ; Are we really doing a switch?
  3022.     beq    cmk3b1        ; Yes, give that message instead
  3023.     ldx    #cmin01\    ; L.O. byte addr of informational message
  3024.     ldy    #cmin01^    ; H.O. byte of addr
  3025.     jmp    cmk3b2        ; Go print the message
  3026. cmk3b1: ldx    #cmin02\    ; Load address of switch message
  3027.     ldy    #cmin02^    ;        ...
  3028. cmk3b2: jsr    prstr        ; Print the message
  3029.     jsr    prcrlf        ; Print a crelf
  3030.     jsr    cmktp        ;    and the valid entries in keyword table
  3031.     jsr    prcrlf        ; Print another crlf
  3032.     lda    #cmfehf        ;  Load extra help flag
  3033.     bit    cmprmy        ;  Test bit
  3034.     beq    cmk3b3        ;  No extra help
  3035.     jsr    cmehlp        ;  Go give extra help
  3036. cmk3b3:    ldx    cm.rty        ; Get  address of prompt
  3037.     ldy    cm.rty+1    ; 
  3038.     jsr    prstr        ; Reprint the prompt
  3039.     lda    #0        ; Clear AC
  3040.     ldy    #0        ; Clear Y
  3041.     sta    (cm.ptr),y    ; Stuff a null in the buffer at that point
  3042.     sec            ; Set the carry
  3043.     lda    cm.bfp        ; Get ready to decrement buffer pointer
  3044.     sbc    #1        ; Subtract it
  3045.     sta    cm.bfp        ; Store it
  3046.     bcs    cmky3a        ; Do we have to account for carry
  3047.     dec    cm.bfp+1    ; Decrement the H.O. byte
  3048. cmky3a: ldx    #cmbuf\        ; Get  address of buffer
  3049.     ldy    #cmbuf^        ;
  3050.     jsr    prstr        ; Reprint the command line
  3051.     jmp    repars        ; Go reparse all of it
  3052. cmky31: cmp    #esc        ; escape character?
  3053.     beq    cmk3c        ; Yup, process it
  3054.     jmp    cmky35        ; Nope.
  3055. cmk3c:  lda    #0        ; Clear AC
  3056.     sta    cmaflg        ; Clear action flag
  3057.     lda    keylen        ; Save on the stack, the
  3058.     pha            ;    keylength
  3059.     lda    cmentr        ;    number of entries left
  3060.     pha            ;        ...
  3061.     lda    cmkptr        ;    L.O. byte of keyword table pointer
  3062.     pha            ;        ...
  3063.     lda    cmkptr+1    ;    H.O. byte of keyword table pointer
  3064.     pha            ;        ...
  3065.     jsr    cmambg        ; Is it ambiguous?
  3066.      jmp    cmky32        ; Nope
  3067.     lda    #cmfdff        ;  Load the default-present flag
  3068.     bit    cmprmy        ;  Check against flags
  3069.     beq    cmk3d        ;  No, complain to user
  3070.     lda    cmfrcf        ;  Have we seen a real character yet?
  3071.     bne    cmk3d        ;  No, tell user
  3072.     jmp    cmcpdf        ;  Yes, go copy the default
  3073. cmk3d:    jsr    bell        ; Yes, start by feeping terminal
  3074.     sec            ; Set the carry bit for subtraction
  3075.     lda    cm.bfp        ; Take L.O. byte of buffer pointer
  3076.     sbc    #1        ; Decrement it (back up before escape)
  3077.     sta    cm.bfp        ; Store it
  3078.     sta    cm.ptr        ; And stuff it in next input char pointer
  3079.     bcs    cmky3b        ; If carry is clear, we are done
  3080.     dec    cm.bfp+1    ; Do the carry on H.O. byte
  3081. cmky3b: lda    cm.bfp+1    ; Copy this to the next char to parse pointer
  3082.     sta    cm.ptr+1    ;        ...
  3083.     dec    cmccnt        ; Decrement the character count
  3084.     pla            ;        ...
  3085.     sta    cmkptr+1    ; Restore the keyword table pointer
  3086.     pla            ;        ...
  3087.     sta    cmkptr        ;
  3088.     pla            ;
  3089.     sta    cmentr        ;    Number of entries left in table
  3090.     pla            ;        ...
  3091.     sta    keylen        ;    And the remaining keylength
  3092.     inc    keylen        ; Adjust the keylength to make it correct
  3093.     jmp    cmkey3        ; And go back to try again
  3094. cmky32: ldy    #0        ; Clear Y
  3095.     sec            ; Set the carry flag
  3096.     lda    cm.bfp        ; Move buffer pointer behind the escape
  3097.     sbc    #1        ;        ...
  3098.     sta    cm.bfp        ;        ...
  3099.     sta    cm.ptr        ;        ...
  3100.     bcs    cmk32c        ;        ...
  3101.     dec    cm.bfp+1    ; Have to adjust the H.O. byte
  3102. cmk32c: lda    cm.bfp+1    ;        ...
  3103.     sta    cm.ptr+1    ;        ...
  3104.     pla            ; Fetch the old keytable pointer
  3105.     sta    cmkptr+1    ;        ...
  3106.     pla            ;        ...
  3107.     sta    cmkptr        ;        ...
  3108.     pha            ; Now push it back on the stack
  3109.     lda    cmkptr+1    ;        ...
  3110.     pha            ;        ...
  3111. cmky33: lda    (cmkptr),y    ; Get next character
  3112.     cmp    #0        ; Done?
  3113.     beq    cmky34        ; Yes
  3114.     tax            ; No, hold on to the byte
  3115.     clc            ; Clear the carry flag
  3116.     lda    cmkptr        ; Adjust the keyword pointer up one place
  3117.     adc    #1        ; Do L.O. byte
  3118.     sta    cmkptr        ; Store it
  3119.     bcc    cmky3c        ; Carry?
  3120.     inc    cmkptr+1    ; Yes, increment H.O. byte
  3121. cmky3c: txa            ; Get the data
  3122.     sta    (cm.ptr),y    ; Stuff it in the buffer
  3123.     clc            ; Clear the carry flag again
  3124.     lda    cm.ptr        ; Get L.O byte of buffer pointer
  3125.     adc    #1        ; Increment it
  3126.     sta    cm.ptr        ; Store it
  3127.     bcc    cmky3d        ; Carry?
  3128.     inc    cm.ptr+1    ; Increment H.O. byte
  3129. cmky3d: inc    cmccnt        ; Increment character count
  3130.     jmp    cmky33        ; Get next character from table
  3131. cmky34: inc    cmccnt        ; Incrment the character count
  3132.     lda    #$A0        ; Clear AC (this is a terminator!)
  3133.     sta    (cm.ptr),y    ; Stuff a null in the buffer
  3134.     ldx    cm.bfp        ; Get L.O. byte of buffer pointer
  3135.     ldy    cm.bfp+1    ;    and H.O byte - save these for later
  3136.     clc            ; Clear carry
  3137.     lda    cm.ptr        ; Increment next char of input pointer
  3138.     adc    #1        ;        ...
  3139.     sta    cm.ptr        ;        ...
  3140.     sta    cm.bfp        ;        ...
  3141.     bcc    cmky3e        ; Carry?
  3142.     inc    cm.ptr+1    ; Do H.O. byte
  3143. cmky3e: lda    cm.ptr+1    ; Make buffer pointer match next char pointer
  3144.     sta    cm.bfp+1    ;        ...
  3145.     sty    savey        ; Hold y for a bit
  3146.     lda    #0        ; Put a null in the buffer to terminate string
  3147.     ldy    #0        ;        ...
  3148.     sta    (cm.ptr),y    ;        ...
  3149.     ldy    savey        ; Get Y value back
  3150.     jsr    prstr        ; Print remainder of keyword
  3151.     pla            ; Restore the
  3152.     sta    cmkptr+1    ;    H.O. byte of keyword table pointer
  3153.     pla            ;        ...
  3154.     sta    cmkptr        ;     L.O. byte of keyword table pointer
  3155.     pla            ;        ...
  3156.     sta    cmentr        ;    Number of entries left in table
  3157.     pla            ;        ...
  3158.     sta    keylen        ;    And the remaining keylength
  3159.     jmp    cmky37        ; Go get some data to return
  3160. cmky35: lda    cmkptr        ; Save on the stack the  keyword table pointer
  3161.     pha            ;
  3162.     lda    cmkptr+1    ;
  3163.     pha            ;        ...
  3164.     lda    keylen        ;    The keylength
  3165.     pha            ;        ...
  3166.     jsr    cmambg        ; Check for ambiguity
  3167.      jmp    cmky36        ; Not ambiguous
  3168.     ldx    #cmer01\    ; Get addr of ambiguous error
  3169.     ldy    #cmer01^    ;        ...
  3170.     jsr    prstr        ; Print the error message
  3171.     jmp    prserr        ; Go do parsing error stuff
  3172. cmky36: pla            ; Fetch off of the stack 
  3173.     sta    keylen        ;    remaining keylength
  3174.     pla            ;        ...
  3175.     sta    cmkptr+1    ;    H.O. byte of keyword table address
  3176.     pla            ;        ...
  3177.     sta    cmkptr        ;     L.O. byte of keyword table address
  3178. cmky37: inc    keylen        ; Adjust the remaining keylength
  3179.     inc    keylen        ;        ...
  3180.     clc            ; Clear the carry flag
  3181.     lda    cmkptr        ; Get the keyword table pointer
  3182.     adc    keylen        ; Add in remaining keylength
  3183.     sta    cmkptr        ; Store it
  3184.     bcc    cmky3f        ; Carry?
  3185.     inc    cmkptr+1    ; Yes, adjust H.O. byte
  3186. cmky3f: ldy    #0        ; Make sure Y is clear
  3187.     lda    (cmkptr),y    ; Get first data byte
  3188.     tax            ; Put it in X
  3189.     iny            ; Up the index once
  3190.     lda    (cmkptr),y    ; Get the second data byte
  3191.     tay            ; Put that in Y
  3192.     pla            ; Flush the old comand line pointer
  3193.     pla            ;        ...
  3194.     lda    #0        ; Reset the failure flag
  3195.     sta    cmcffl        ; 
  3196.     jmp    rskp        ; Return skip means it succeeds!
  3197. cmkey4: cmp    #$41        ; Check range for upper case
  3198.     bmi    cmky41        ;        ...
  3199.     cmp    #$5b        ;        ...
  3200.     bpl    cmky41        ;        ...
  3201.     ora    #$20        ; Cutesy way to convert to lower case
  3202. cmky41: sta    cmwrk3        ; Save the character
  3203.     lda    #$FF        ;  Set the 'real character' flag
  3204.     sta    cmfrcf        ; 
  3205.     ldy    #0        ; Clear Y again
  3206.     lda    (cmkptr),y    ; Get next keyword byte
  3207.     sta    cmwrk4        ; Hold that for now
  3208.     clc            ; Clear the carry flag
  3209.     lda    cmkptr        ; Get L.O. byte of keyword pointer
  3210.     adc    #1        ; Add one
  3211.     sta    cmkptr        ; Store it
  3212.     bcc    cmky4a        ; Need to do carry?
  3213.     inc    cmkptr+1    ; Yes, do H.O. byte
  3214. cmky4a: lda    cmwrk3        ; Get input character
  3215.     cmp    cmwrk4        ; Does it match keyword character?
  3216.     bne    cmkey5        ; No, advance to next keyword in table
  3217.     jmp    cmkey3        ; Yup, try next input byte
  3218. cmkey5: inc    keylen        ; Adjust keylength so that it is correct
  3219.     inc    keylen        ;        ...
  3220.     inc    keylen        ;        ...
  3221.     clc            ; Clear carry
  3222.     lda    cmkptr        ; Ok, get keyword pointer and
  3223.     adc    keylen        ; Add the remaining keylength
  3224.     sta    cmkptr        ; Store it
  3225.     bcc    cmky5a        ; See if we have to do carry
  3226.     inc    cmkptr+1    ; Yes, increment H.O. byte
  3227. cmky5a: dec    cmentr        ; Decrement the number of entries left
  3228.     lda    cmsptr        ; Get the saved buffer pointer and
  3229.     sta    cm.ptr        ;    restore it
  3230.     lda    cmsptr+1    ;        ...
  3231.     sta    cm.ptr+1    ;        ...
  3232.     jmp    cmkey2        ; Try to parse this keyword now
  3233.  
  3234. .SBTTL    Cmambg - check if keyword prefix is ambiguous
  3235.  
  3236. ;
  3237. ;    This routine looks at the next keyword in the table and
  3238. ;    determines if the prefix entered in the buffer is ambiguous
  3239. ;    or not. If it is ambiguous, it skip returns, otherwise it
  3240. ;    returns normally.
  3241. ;
  3242. ;        Input:  Cmentr- number of entries left in table
  3243. ;            Cmkptr- current keyword table pointer
  3244. ;            Keylen- remaining keyword length
  3245. ;
  3246. ;        Output: If ambiguous, does a skip return
  3247. ;
  3248. ;        Registers destroyed:    A,X,Y
  3249. ;
  3250.  
  3251. cmambg: dec    cmentr        ; Start by decrementing remaining entries
  3252.     bpl    cma1        ; We still have stuff left
  3253.     rts            ; Nothing left, it can't be ambiguous
  3254. cma1:    inc    keylen        ; Adjust this up by one
  3255.     lda    keylen        ; Save character count
  3256.     sta    cmwrk3        ;        ...
  3257.     clc            ; Clear the carry
  3258.     adc    #3        ; Adjust the keylength to include terminator
  3259.     sta    keylen        ;    and data bytes
  3260.     clc            ; Clear carry
  3261.     lda    cmkptr        ; Up the keyword table pointer
  3262.     adc    keylen        ;    by remaining keylength
  3263.     sta    cmkptr        ; Save it
  3264.     bcc    cma2        ; Need to adjust H.O byte?
  3265.     inc    cmkptr+1    ; Yes, do it
  3266. cma2:    ldy    #0        ; Clear Y
  3267.     lda    (cmkptr),y    ; Get keyword length
  3268.     sta    cmwrk4        ; Hold that byte
  3269.     clc            ; Clear carry
  3270.     lda    cmkptr        ; Advance keyword table pointer
  3271.     adc    #1        ;        ...
  3272.     sta    cmkptr        ;        ...
  3273.     bcc    cma3        ;        ...
  3274.     inc    cmkptr+1    ;        ...
  3275. cma3:    lda    (cmspt2),y    ; Get previous keyword length
  3276.     sec            ; Set carry
  3277.     sbc    cmwrk3        ; Subtract number of characters left
  3278.     beq    cmambs        ;  If test len is 0, don't bother trying
  3279.     sta    cmtlen        ; This is the testing length
  3280.     cmp    cmwrk4        ; Check this against length of new keyword
  3281.     bmi    cmamb0        ; This may be ambiguous
  3282.     rts            ; Test length is longer, cannot be ambiguous
  3283. cmamb0: ldy    #0        ; Clear Y
  3284. cmamb1: dec    cmtlen        ; Decrement the length to test
  3285.     bpl    cma4        ; Still characters left to check
  3286. cmambs:    jmp    rskp        ;  The whole thing matched, it is ambiguous
  3287. cma4:    lda    (cmkptr),y    ; Get next character of keyword
  3288.     sta    cmwrk3        ; Hold that for now
  3289.     lda    (cmsptr),y    ; Get next parsed character
  3290.     iny            ; Up the pointer once
  3291.     cmp    #$61        ; Check the range for lower case
  3292.     bmi    cmamb2        ;        ...
  3293.     cmp    #$7B        ;        ...
  3294.     bpl    cmamb2        ;        ...
  3295.     and    #$5F        ; Capitalize it
  3296. cmamb2:    and    #$7F        ; Reset the H.O. bit
  3297.     cmp    cmwrk3        ; Same as keyword table character
  3298.     beq    cmamb1        ; Yup, check next character
  3299.     rts            ; Nope, prefix is not ambiguous
  3300.  
  3301.  
  3302. .SBTTL    Cmktp - print entries in keyword table matching prefix
  3303.  
  3304. ;
  3305. ;    This routine steps through the keyword table passed to cmkeyw
  3306. ;    and prints all the keywords with the prefix currently in the
  3307. ;    command buffer. If there is no prefix, it issues an error.
  3308. ;
  3309. ;        Input:  Cmptab- ptr to beginning of table
  3310. ;            Cmsptr- saved buffer pointer
  3311. ;            Cm.ptr- current buffer pointer
  3312. ;
  3313. ;        Output: List of possible keywords to screen
  3314. ;
  3315. ;        Registers destroyed:    A,X,Y
  3316. ;
  3317.  
  3318. cmktp:  lda    cmptab        ; Get a copy of the pointer
  3319.     sta    cminf2        ;    to the beginning of
  3320.     lda    cmptab+1    ;    the current keyword table
  3321.     sta    cminf2+1    ;        ...
  3322.     ldy    #0        ; Clear Y
  3323.     sty    cmscrs        ; Clear the 'which half of screen' switch
  3324.     sty    cmwrk3        ; Clear the 'print any keywords?' switch
  3325.     lda    (cminf2),y    ; Get the table length
  3326.     sta    cmwrk1        ;    and save it in a safe place
  3327.     sec            ; Prepare for some subtracting
  3328.     lda    cm.ptr        ; Get difference between the current pointer
  3329.     sbc    cmsptr        ;    and pointer to beginning of keyword
  3330.     sta    cmtlen        ; That is how much we must test
  3331.     clc            ; Clear carry
  3332.     lda    cminf2        ; Increment the pointer to the table
  3333.     adc    #1        ;        ...
  3334.     sta    cminf2        ;        ...
  3335.     bcc    cmktp1        ; Need to increment H.O. byte?
  3336.     inc    cminf2+1    ; Yup
  3337. cmktp1: dec    cmwrk1        ; 1 less keyword to do
  3338.     lda    cmwrk1        ; Now...
  3339.     bmi    cmkdon        ; No keywords left, we are done
  3340.     lda    (cminf2),y    ; Get the keyword length
  3341.     sta    cmkyln        ;    and stuff it
  3342.     clc            ; Clear carry
  3343.     lda    cminf2        ; Increment pointer to table again
  3344.     adc    #1        ;        ...
  3345.     sta    cminf2        ;        ...
  3346.     bcc    cmktp2        ; Need to up the H.O. byte?
  3347.     inc    cminf2+1    ; Yup
  3348. cmktp2: lda    cmtlen        ; Get test length
  3349.     beq    cmktp3        ; If test length is zero, just print keyword
  3350. cmkp21: lda    (cminf2),y    ; Get character from table
  3351. ; zzz do case-insensitive compare here
  3352.     cmp    (cmsptr),y    ; Compare it to the buffer character
  3353.     bne    cmadk        ; Nope, advance to next keyword
  3354.     iny            ; Up the index
  3355.     cpy    cmtlen        ; Compare with the test length
  3356.     bmi    cmkp21        ; Not yet, do next character
  3357. cmktp3: jsr    cmprk        ; Print the keyword
  3358.  
  3359. cmadk:  inc    cmkyln        ; Adjust cmkyln to include terminator and data
  3360.     inc    cmkyln        ;        ...
  3361.     inc    cmkyln        ;        ...
  3362.     clc            ; Clear the carry
  3363.     lda    cminf2        ; Get the L.O. byte
  3364.     adc    cmkyln        ; Add in the keyword length
  3365.     sta    cminf2        ; Store it away
  3366.     bcc    cmadk2        ; Need to do the H.O. byte?
  3367.     inc    cminf2+1    ; Yup
  3368. cmadk2: ldy    #0        ; Zero the index
  3369.     jmp    cmktp1        ; Go back to the top of the loop
  3370.  
  3371. cmkdon: lda    cmwrk3        ; See if we printed anything
  3372.     bne    cmkdn2        ; Yup, go exit
  3373.     lda    cmstat        ; Are we parsing switches or keywords?
  3374.     cmp    #cmswi        ;        ...
  3375.     beq    cmkdse        ; The error should be for switches
  3376.     ldx    #cmer03\    ; Nope, get address of error message
  3377.     ldy    #cmer03^    ;        ...
  3378.     jmp    cmkdn1        ; Go print the message now
  3379. cmkdse: ldx    #cmer04\    ; Get address of switch error message
  3380.     ldy    #cmer04^    ;        ...
  3381. cmkdn1: jsr    prstr        ; Print error
  3382.     jsr    prcrlf        ; Print a crelf
  3383. cmkdn2: lda    cmscrs        ; Where did we end up?
  3384.     beq    cmkdn3        ; Beginning of line, good
  3385.     jsr    prcrlf        ; Print a crelf
  3386. cmkdn3: rts            ; Return
  3387.  
  3388. ;
  3389. ;    Cmprk - prints one keyword from the table. Consults the
  3390. ;        cmscrs switch to see which half of the line it
  3391. ;        is going to and acts accordingly.
  3392. ;
  3393. ;        Input:  Cmscrs- Which half of screen
  3394. ;            Cminf2- Pointer to string to print
  3395. ;
  3396. ;        Output: print keyword on screen
  3397. ;
  3398. ;        Registers destroyed:    A,X,Y
  3399. ;
  3400.  
  3401. cmprk:  lda    #on        ; Make sure to tell them we printed something
  3402.     sta    cmwrk3        ; Put it back
  3403.     lda    cmstat        ; Get saved parse type
  3404.     cmp    #cmswi        ; Is it a switch we are looking for?
  3405.     bne    cmpr2        ;
  3406.     lda    #'/        ; Yes, do not forget slash prefix
  3407.     jsr    cout        ; Print slash
  3408. cmpr2:  ldx    cminf2        ; L.O. byte of string pointer
  3409.     ldy    cminf2+1    ; H.O. byte of string pointer
  3410.     jsr    prstr        ; Print the keyword
  3411.     lda    cmscrs        ; Where were we?
  3412.     bne    cmprms        ; Mid screen
  3413.     jsr    screl0        ; Clear to end of line
  3414.     sec            ;[37] Get cursor coordinates
  3415.     jsr    ploth        ;[37]        ...
  3416. ;    ldy    #$14        ; Advance cursor to middle of screen
  3417.     ldx    #$14        ; Advance cursor to middle of screen
  3418.     clc            ;[DD]        ...
  3419.     jsr    ploth        ;[DD][26]    ...
  3420.     jmp    cmprdn        ; We are done
  3421. cmprms: jsr    prcrlf        ; Print a crelf
  3422. cmprdn: lda    cmscrs        ; Flip the switch now
  3423.     eor    #$01
  3424.     sta    cmscrs        ; Stuff it back
  3425.     rts            ; Return
  3426.  
  3427. .SBTTL    Cmswit - try to parse a switch next
  3428.  
  3429. ;
  3430. ;    This routine tries to parse a switch from the command buffer. It
  3431. ;    first looks for the / and then calls cmkeyw to handle the keyword
  3432. ;    lookup.
  3433. ;
  3434. ;        Input:  Cminf1- Address of keyword table
  3435. ;
  3436. ;        Output: X-    byte a
  3437. ;            Y-    byte b
  3438. ;
  3439. ;        Registers destroyed:    A,X,Y
  3440. ;
  3441. ; well, this is pretty gross.  This sucker appears never to be
  3442. ; called; undoubtedly cause this is a general purpose command parser
  3443. ; from elsewhere.  I'm leaving the code here, but commented out in
  3444. ; case anyone ever wants to use it;
  3445. ; 
  3446. cmswit: brk            ; [jrd] you better put it back before
  3447.                 ;  trying to use it
  3448. ;    lda    cm.ptr        ; Save the old comand line pointer
  3449. ;    pha            ;    user wants to try another item
  3450. ;    lda    cm.ptr+1    ;        ...
  3451. ;    pha            ;        ...
  3452. ;cmswi0: jsr    cmgtch        ; Go get a character
  3453. ;    cmp    #0        ; Action?
  3454. ;    bmi    cmswi1        ; Yes, process it
  3455. ;    jmp    cmswi3        ; No, it is a real character
  3456. ;cmswi1: and    #$7F        ; Turn off the minus
  3457. ;    cmp    #'?        ; Does the user need help?
  3458. ;    bne    cmsw12        ; No
  3459. ;    jsr    cout        ; And print the question mark
  3460. ;    lda    #0        ; Clear AC
  3461. ;    sta    cmaflg        ; Clear Action flag
  3462. ;    ldx    #cmin02\    ; Low order byte addr of info message
  3463. ;    ldy    #cmin02^    ; High order byte addr of info message
  3464. ;    jsr    prstr        ; Print the message
  3465. ;    jsr    prcrlf        ; Print a crelf
  3466. ;    jsr    cmktp        ; Any valid entries from keyword table
  3467. ;    jsr    prcrlf        ; And another crelf
  3468. ;    lda    #cmfehf        ;  Load extra help flag
  3469. ;    bit    cmprmy        ;  Test bit
  3470. ;    beq    cmsw10        ;  No extra help
  3471. ;    jsr    cmehlp        ;  Go give extra help
  3472. ;cmsw10:    ldx    cm.rty        ; Load the address of the prompt
  3473. ;    ldy    cm.rty+1    ;
  3474. ;    jsr    prstr        ; Reprint it
  3475. ;    lda    #0        ; Clear AC
  3476. ;    ldy    #0        ; Clear Y
  3477. ;    sta    (cm.ptr),y    ; Stuff a null at the end of the buffer
  3478. ;    sec            ; Set the carry flag
  3479. ;    lda    cm.bfp        ; Increment buffer pointer
  3480. ;    sbc    #1        ;        ...
  3481. ;    sta    cm.bfp        ;        ...
  3482. ;    bcs    cmsw1a        ; Borrow?
  3483. ;    dec    cm.bfp+1    ; Yup
  3484. ;cmsw1a: ldx    #cmbuf\        ; L.O. addr of command buffer
  3485. ;    ldy    #cmbuf^        ; H.O. byte
  3486. ;    jsr    prstr        ; Reprint the command line
  3487. ;    jmp    repars        ; Go reparse everything
  3488. ;cmsw12: cmp    #esc        ; Lazy??
  3489. ;    beq    cmsw2a        ; Yes, try to help
  3490. ;    jmp    cmswi2        ; No, this is something else
  3491. ;cmsw2a: lda    #0        ; Clear AC
  3492. ;    sta    cmaflg        ; Clear action flag
  3493. ;    lda    #cmfdff        ;  See if there is a default
  3494. ;    bit    cmprmy        ; 
  3495. ;    beq    cmswnd        ;  No help, tell user
  3496. ;    jmp    cmcpdf        ;  Go copy the default
  3497. ;cmswnd:    jsr    bell        ; Yes, it is ambiguous - ring bell
  3498. ;    sec            ; Set carry
  3499. ;    lda    cm.bfp        ; Decrement buffer pointer
  3500. ;    sbc    #1        ;        ...
  3501. ;    sta    cm.bfp        ;        ...
  3502. ;    sta    cm.ptr        ; Make this pointer point there too
  3503. ;    bcs    cmsw2b        ; No carry to handle
  3504. ;    dec    cm.bfp+1    ; Do H.O. byte
  3505. ;cmsw2b: lda    cm.bfp+1    ; Now make H.O. byte match
  3506. ;    sta    cm.ptr+1    ;        ...
  3507. ;    dec    cmccnt        ; Decrement the character count
  3508. ;    jmp    cmswi0        ; Try again
  3509. ;cmsw2c: lda    #'/        ; Load a slash
  3510. ;    jsr    cout        ; Print slash
  3511. ;    clc            ; Clear carry
  3512. ;    lda    cminf1        ; Set the keyword table pointer
  3513. ;    adc    #2        ;    to point at the beginning
  3514. ;    sta    cmkptr        ;    of the keyword and move it
  3515. ;    lda    cminf1+1    ;    to cmkptr
  3516. ;    bcc    cmsw2d        ;        ...
  3517. ;    adc    #0        ;        ...
  3518. ;cmsw2d: sta    cmkptr+1    ;        ...
  3519. ;    ldy    #0        ; Clear Y
  3520. ;    sec            ; Set carry
  3521. ;    lda    cm.bfp        ; Increment the buffer pointer
  3522. ;    sbc    #1        ;        ...
  3523. ;    sta    cm.bfp        ;        ...
  3524. ;    bcs    cmsw2e        ;        ...
  3525. ;    dec    cm.bfp+1    ;        ...
  3526. ;cmsw2e: lda    (cmkptr),y    ; Get next character
  3527. ;    cmp    #0        ; Done?
  3528. ;    beq    cmsw13        ; Yes
  3529. ;    tax            ; No, hold on to the byte
  3530. ;    clc            ;    while we increment the pointer
  3531. ;    lda    cmkptr        ; Do L.O. byte
  3532. ;    adc    #1        ;        ...
  3533. ;    sta    cmkptr        ;        ...
  3534. ;    bcc    cmsw2f        ; And, if neccesary
  3535. ;    inc    cmkptr+1    ;    the H.O. byte as well
  3536. ;cmsw2f: txa            ; Get the data
  3537. ;    sta    (cm.ptr),y    ; Stuff it in the buffer
  3538. ;    clc            ; Clear carry
  3539. ;    lda    cm.ptr        ; Increment the next character pointer
  3540. ;    adc    #1        ;        ...
  3541. ;    sta    cm.ptr        ;        ...
  3542. ;    bcc    cmsw2g        ;        ...
  3543. ;    inc    cm.ptr+1    ;        ...
  3544. ;cmsw2g: inc    cmccnt        ; Increment the character count
  3545. ;    jmp    cmsw2e        ; Get next character from table
  3546. ;cmsw13: inc    cmccnt        ; Increment the character count
  3547. ;    lda    #0        ; Clear AC
  3548. ;    sta    (cm.ptr),y    ; Stuff a null in the buffer
  3549. ;    ldx    cm.bfp        ; Hold on to this pointer
  3550. ;    ldy    cm.bfp+1    ;    for later printing of switch
  3551. ;    clc            ; Clear carry
  3552. ;    lda    cm.ptr        ; Now make both pointers look like
  3553. ;    adc    #1        ;    (cm.ptr)+1
  3554. ;    sta    cm.ptr        ;        ...
  3555. ;    sta    cm.bfp        ;        ...
  3556. ;    bcc    cmsw3a        ;        ...
  3557. ;    inc    cm.ptr+1    ;        ...
  3558. ;cmsw3a: lda    cm.ptr+1    ; Copy H.O. byte
  3559. ;    sta    cm.bfp+1    ;        ...
  3560. ;    jsr    prstr        ; Now print string with pointer saved earlier
  3561. ;;
  3562. ;; well this is ridiculous...
  3563. ;;    ldx    #1        ; Set up argument
  3564. ;;    jsr    prbl2        ; Print one blank
  3565. ;    lda    #space        ; [jrd] now isn't this 
  3566. ;    jsr    cout        ;  easier?
  3567. ;cmsw14: clc            ; Clear carry
  3568. ;    lda    cmkptr        ; Increment keyword pointer
  3569. ;    adc    #1        ; Past null terminator
  3570. ;    sta    cmkptr        ;        ...
  3571. ;    bcc    cmsw4a        ;        ...
  3572. ;    inc    cmkptr+1    ;        ...
  3573. ;cmsw4a: ldy    #0        ; Clear Y
  3574. ;    lda    (cmkptr),y    ; Get first data byte
  3575. ;    tax            ; Put it here
  3576. ;    iny            ; Up the index
  3577. ;    lda    (cmkptr),y    ; Get second data byte
  3578. ;    tay            ; Put that in Y
  3579. ;    pla            ; Flush the old comand line pointer
  3580. ;    pla            ;        ...
  3581. ;    lda    #0        ;  Clear the failure flag
  3582. ;    sta    cmcffl        ;         ...
  3583. ;    jmp    rskp        ; And give a skip return
  3584. ;cmswi2: ldy    #0        ; Clear Y
  3585. ;    lda    (cminf1),y    ; Get length of table
  3586. ;    cmp    #2        ; Greater than 1
  3587. ;    bmi    cmsw21        ; No, go fetch data
  3588. ;    ldx    #cmer01\    ; Yes, fetch pointer to error message
  3589. ;    ldy    #cmer01^    ;        ...
  3590. ;    jsr    prstr        ; Print the error
  3591. ;    jmp    prserr        ; And go handle the parser error
  3592. ;cmsw21: iny            ; Add one to the index
  3593. ;    lda    (cminf1),y    ; Get the length of the keyword
  3594. ;    sta    keylen        ; Save that
  3595. ;    lda    cminf1+1    ; Copy pointer to table
  3596. ;    sta    cmkptr+1    ;        ...
  3597. ;    clc            ; Get set to increment an address
  3598. ;    lda    cminf1        ; Do L.O. byte last for efficiency
  3599. ;    adc    keylen        ; Add in the keyword length
  3600. ;    adc    #2        ; Now account for table length and terminator
  3601. ;    sta    cmkptr        ; Save the new pointer
  3602. ;    bcc    cmsw22        ; If no carry, continue
  3603. ;    inc    cmkptr+1    ; Adjust H.O. byte
  3604. ;cmsw22: jmp    cmsw4a        ; Go to load data and skip return
  3605. ;cmswi3: cmp    #'/        ; Is the real character a slash?
  3606. ;    beq    cmswi4        ; Yes, go do the rest
  3607. ;    tax            ; Move the data byte
  3608. ;    lda    #0        ; Clear AC
  3609. ;    pla            ; Fetch back the old comand line pointer
  3610. ;    sta    cm.ptr+1    ;        ...
  3611. ;    sta    cmoptr+1    ;         ...
  3612. ;    pla            ;        ...
  3613. ;    sta    cm.ptr        ;        ...
  3614. ;    sta    cmoptr        ;        ...
  3615. ;    lda    cmccnt        ;  Save count in case of <ctrl/H>
  3616. ;    sta    cmocnt        ;  
  3617. ;    lda    #$FF        ;  Set failure  flag
  3618. ;    sta    cmcffl        ;         ...
  3619. ;    rts            ; Fail - non-skip return
  3620. ;cmswi4: jsr    cmkeyw        ; Let Keyw do the work for us
  3621. ;     jmp    cmswi5        ; We had problems, restore comand ptr and ret.
  3622. ;    pla            ; Flush the old comand pointer
  3623. ;    pla
  3624. ;    lda    #0        ;  Reset the failre flag
  3625. ;    sta    cmcffl        ; 
  3626. ;    jmp    rskp        ; Success - skip return!
  3627. ;cmswi5: pla            ; Fetch back the old comand line pointer
  3628. ;    sta    cm.ptr+1    ;        ...
  3629. ;    sta    cmoptr+1    ;         ...
  3630. ;    pla            ;        ...
  3631. ;    sta    cm.ptr        ;        ...
  3632. ;    sta    cmoptr        ;         ...
  3633. ;    lda    cmccnt        ;  Save count in case of <ctrl/H>
  3634. ;    sta    cmocnt        ; 
  3635. ;    lda    #$FF        ;  Set failure flag
  3636. ;    sta    cmcffl        ; 
  3637. ;    rts            ; Now return
  3638. ;
  3639. ; [jrd] end of commented out switch parser
  3640. ;
  3641.  
  3642. .SBTTL    Cmifil - try to parse an input file spec next
  3643.  
  3644. ;
  3645. ;    This routine attempts to parse an input file spec.
  3646. ;
  3647. ;        Input:  X - Max filename length
  3648. ;
  3649. ;        Output: Filename parsed is in buffer pointed to by X,Y
  3650. ;
  3651. ;        Registers destroyed:    A,X,Y
  3652. ;
  3653.  
  3654. cmifil: inx            ;  Increment max file length for tests
  3655.     stx    cmprmx        ;  Maximum filename length
  3656.     lda    cm.ptr        ; Save the old comand line pointer in case
  3657.     pha            ;
  3658.     lda    cm.ptr+1    ;
  3659.     pha            ;
  3660.     lda    #0        ; Zero the
  3661.     sta    lenabf        ;  length of the atom buffer
  3662. cmifl0: ldy    #0        ; Zero Y
  3663.     lda    #'            ; Blank the AC 
  3664.     ora    #$80        ; Make it look like a terminator
  3665. cmifi0: sta    atmbuf,y    ; Now zero the buffer
  3666.     iny            ;        ...
  3667.     cpy    cmprmx      ;  Done?
  3668.     bpl    cmifi1        ; Yes, start parsing
  3669.     jmp    cmifi0        ; No, continue blanking
  3670. cmifi1: jsr    cmgtch        ; Get a character from command buffer
  3671.     cmp    #0        ; Is it an action character?
  3672.     bmi    cmif10        ;  Yes, check it out
  3673.     jmp    cmifi2        ;  No , process it as a normal character
  3674. cmif10:    and    #$7F        ;  Yes, turn off the minus bit
  3675.     cmp    #'?        ; Does the user need help?
  3676.     bne    cmif12        ; Nope
  3677.     jsr    cout        ; And print the question mark
  3678.     ldy    #0        ; Yes
  3679.     sty    cmaflg        ; Clear the action flag
  3680.     ldx    #cmin03\    ; Now get set to give the 'file spec' message
  3681.     ldy    #cmin03^    ;        ...
  3682.     jsr    prstr        ; Print it
  3683.     jsr    prcrlf        ; Print a crelf
  3684.     lda    #cmfehf        ;  Load extra help flag
  3685.     bit    cmprmy        ;  Test bit
  3686.     beq    cmifnh        ;  No extra help
  3687.     jsr    cmehlp        ;  Go give extra help
  3688. cmifnh:    ldx    cm.rty        ;  Set up to reprint the prompt
  3689.     ldy    cm.rty+1    ;        ...
  3690.     jsr    prstr        ; Do it
  3691.     sec            ; Set the carry flag for subtraction
  3692.     lda    cm.bfp        ; Get the buffer pointer
  3693.     sbc    #1        ; Decrement it once
  3694.     sta    cm.bfp        ;        ...
  3695.     bcs    cmif11        ; If it's set, we need not do H.O. byte
  3696.     dec    cm.bfp+1    ; Adjust the H.O. byte
  3697. cmif11: dec    cmccnt        ; Decrement the character count
  3698.     ldy    #0        ; Clear Y
  3699.     lda    #0        ; Clear AC
  3700.     sta    (cm.bfp),y    ; Stuff a null at the end of the command buffer
  3701.     ldx    #cmbuf\        ; Now get the address of the command buffer
  3702.     ldy    #cmbuf^        ;        ...
  3703.     jsr    prstr        ; Reprint the command line
  3704.     jmp    cmifi1        ; Go back and continue
  3705. cmif12: cmp    #esc        ; Got an escape?
  3706.     bne    cmif13        ; No
  3707.     lda    #0        ; Yup, clear the action flag
  3708.     sta    cmaflg        ;        ...
  3709.     lda    #cmfdff        ;  Load default-present flag
  3710.     bit    cmprmy        ;  Test bit
  3711.     beq    cmifnd        ;  No default
  3712.     lda    lenabf        ;  Now check if user typed anything
  3713.     bne    cmifnd        ;  Yup, can't use default
  3714.     jmp    cmcpdf        ;  Go copy the default
  3715. cmifnd:    jsr    bell        ; Escape does not work here, ring the bell
  3716.     sec            ; Set carry for subtraction
  3717.     lda    cm.bfp        ; Decrement the buffer pointer
  3718.     sbc    #1        ;    once
  3719.     sta    cm.bfp        ;        ...
  3720.     sta    cm.ptr        ; Make both pointers look at the same spot
  3721.     lda    cm.bfp+1    ;        ...
  3722.     sbc    #0        ; H.O. byte adjustment
  3723.     sta    cm.bfp+1    ;        ...
  3724.     sta    cm.ptr+1    ;        ...
  3725.     dec    cmccnt        ; Decrement the character count
  3726.     jmp    repars        ;    and go reparse everything
  3727. cmif13: lda    lenabf        ;  Get the length of the buffer
  3728.     cmp    #0        ; Is it zero?
  3729.     bne    cmif14        ; No, continue
  3730.     jmp    cmifi9        ; Yes, this is not good
  3731. cmif14: cmp    cmprmx      ;  Are we over the maximum file length?
  3732.     bmi    cmif15        ; Not quite yet
  3733.     jmp    cmifi9        ; Yes, blow up
  3734. cmif15: ldy    lenabf        ;  Get the filename length
  3735.     lda    #nul        ;    and stuff a null at that point
  3736.     sta    atmbuf,y    ; 
  3737.     pla            ; Flush the old comand line pointer
  3738.     pla            ;        ...
  3739.     ldx    #atmbuf\    ;  Set up the atombuffer address
  3740.     ldy    #atmbuf^    ;        ...
  3741.     lda    #0        ;  Reset the failure flag
  3742.     sta    cmcffl        ; 
  3743.     lda    lenabf        ;  Load length into AC to be passed back
  3744.     jmp    rskp        ; No, we are successful
  3745. cmifi2: cmp    #sp        ;  Bad character?
  3746.     bmi    cmifi9        ; Yes, blow up
  3747.     cmp    #del        ; 
  3748.     bpl    cmifi9        ; This is bad, punt
  3749.     cmp    #$61        ; Lower case alphabetic?
  3750.     bmi    cmifi8        ; Don't capitalize if it's not alphabetic
  3751.     cmp    #$7B        ;        ...
  3752.     bpl    cmifi8        ;        ...
  3753.     and    #$5F        ; Capitalize
  3754. cmifi8: ldy    lenabf        ;  Set up length of buffer in Y
  3755.     sta    atmbuf,y    ;  Stuff character in FCB
  3756.     inc    lenabf        ;  Increment the length of the name
  3757.     jmp    cmifi1        ; Go back for the next character
  3758. cmifi9: pla            ; Restore the old comand line pointer
  3759.     sta    cm.ptr+1    ;  in case the user wants to parse
  3760.     sta    cmoptr+1    ;         ...
  3761.     pla            ;    for something else
  3762.     sta    cm.ptr        ;        ...
  3763.     sta    cmoptr        ;         ...
  3764.     lda    cmccnt        ;  Save count in case of <ctrl/H>
  3765.     sta    cmocnt        ;         ...
  3766.     lda    #$FF        ;  Set failure flag
  3767.     sta    cmcffl        ; 
  3768.     rts
  3769.  
  3770. .SBTTL    Cmofil - try to parse an output file spec
  3771.  
  3772. ;
  3773. ;    This routine attempts to parse an output file spec from the
  3774. ;    command buffer.
  3775. ;
  3776. ;        Input:  cminf1- Pointer to FCB
  3777. ;
  3778. ;        Output:
  3779. ;
  3780. ;        Registers destroyed:
  3781. ;
  3782.  
  3783. cmofil: jmp    cmifil        ; Same as parsing input file spec for now
  3784.  
  3785. .SBTTL    Cminum - Try to parse an integer number
  3786.  
  3787. ;
  3788. ;    This routine tries to parse an integer number in the base
  3789. ;    specified. It will return a 16-bit number in cmintg.
  3790. ;    Cmintg is formatted H.O. byte first!
  3791. ;
  3792. ;        Input:  X-    Base of integer (2<=x<=16)
  3793. ;
  3794. ;        Output: Cmintg- 16-bit integer
  3795. ;
  3796. ;        Registers destroyed:    A,X,Y
  3797. ;
  3798.  
  3799. cminum: lda    cm.ptr        ; Save the old comand line pointer
  3800.     pha            ;        ...
  3801.     lda    cm.ptr+1    ;        ...
  3802.     pha            ;        ...
  3803.     cpx    #$11        ; Are we within the proper range?
  3804.     bmi    cmin1        ; If so, check high range
  3805.     jmp    cmine1        ; No, tell them about it
  3806. cmin1:  cpx    #2        ; Too small of a base??
  3807.     bpl    cmin2        ; No, continue
  3808.     jmp    cmine1        ; Base too small, tell them about it
  3809. cmin2:  stx    cmbase        ; The base requested is good, store it
  3810.     lda    #0        ; Clear AC
  3811.     sta    cmmres        ;    and initialize these areas
  3812.     sta    cmmres+1    ;        ...
  3813.     sta    cmmres+2    ;        ...
  3814.     sta    cmmres+3    ;        ...
  3815.     sta    cmintg        ;        ...
  3816.     sta    cmintg+1    ;        ...
  3817.     sta    cmintg+2    ;        ...
  3818.     sta    cmintg+3    ;        ...
  3819. cminm1: jsr    cmgtch        ; Get next character from command buffer
  3820.     cmp    #0        ; Is this an action character
  3821.     bmi    cmin1a        ; Yes, handle it
  3822.     jmp    cminm4        ; No, look for a digit
  3823. cmin1a: and    #$7F        ; It is, turn off the H.O. bit
  3824.     cmp    #esc        ; Is it an escape?
  3825.     bne    cminm2        ; No, try something else
  3826.     lda    #cmfdff        ;  Load default-present flag
  3827.     bit    cmprmy        ;  Test bit
  3828.     beq    cminnd        ;  No, default
  3829.     lda    cmmres        ;  Check if user typed anything significant
  3830.     ora    cmmres+1    ;         ...
  3831.     bne    cminnd        ;  Yup, can't use default
  3832.     jmp    cmcpdf        ;  Go copy the default
  3833. cminnd:    jsr    bell        ; Yes, but escape is not allowed, ring bell
  3834.     lda    #0        ; Zero
  3835.     sta    cmaflg        ;    the action flag
  3836.     sec            ; Set the carry flag for subtraction
  3837.     lda    cm.bfp        ; Get the command buffer pointer
  3838.     sbc    #1        ; Decrement it once
  3839.     sta    cm.bfp        ; Store it away
  3840.     sta    cm.ptr        ; Make this pointer look like it also
  3841.     bcs    cmin11        ; If carry set don't adjust H.O. byte
  3842.     dec    cm.bfp+1    ; Adjust the H.O. byte
  3843. cmin11: lda    cm.bfp+1    ; Move a copy of this H.O. byte
  3844.     sta    cm.ptr+1    ;    to this pointer
  3845.     dec    cmccnt        ; Decrement the character count
  3846.     jmp    cminm1        ; Go try for another character
  3847. cminm2: cmp    #'?        ; Does the user need help?
  3848.     bne    cminm3        ; If not, back up the pointer and accept
  3849.     jsr    cout        ; And print the question mark
  3850.     ldx    #cmin05\    ; Set up the pointer to info message to be
  3851.     ldy    #cmin05^    ;    printed
  3852.     jsr    prstr        ; Print the text of the message
  3853.     lda    cmbase        ; Get the base of the integer number
  3854.     cmp    #$0A        ; Is it greater than decimal 10?
  3855.     bmi    cmin21        ; No, just print the L.O. digit
  3856.     clc            ; Clear the carry
  3857.     lda    #1        ; Print the H.O. digit as a 1
  3858.     adc    #$30        ; Make it printable
  3859.     jsr    cout        ; Print the '1'
  3860.     lda    cmbase        ; Get the base back
  3861.     sec            ; Set the carry flag for subtraction
  3862.     sbc    #$0A        ; Subtract off decimal 10
  3863. cmin21: clc            ; Clear carry for addition
  3864.     adc    #$30        ; Make it printable
  3865.     jsr    cout        ; Print the digit
  3866.     jsr    prcrlf        ; Print a crelf
  3867.     lda    #cmfehf        ;  Load extra help flag
  3868.     bit    cmprmy        ;  Test bit
  3869.     beq    cminnh        ;  No extra help
  3870.     jsr    cmehlp        ;  Go give extra help
  3871. cminnh:    ldx    cm.rty        ; Set up the pointer so we can print the prompt
  3872.     ldy    cm.rty+1    ;        ...
  3873.     jsr    prstr        ; Reprint the prompt
  3874.     lda    #0        ; Clear AC
  3875.     ldy    #0        ; Clear Y
  3876.     sta    (cm.ptr),y    ; Drop a null at the end of the command buffer
  3877.     sec            ; Set the carry flag for subtraction
  3878.     lda    cm.bfp        ; Get the L.O. byte of the address
  3879.     sbc    #1        ; Decrement it once
  3880.     sta    cm.bfp        ; Store it back
  3881.     bcs    cmin22        ; If carry set, don't adjust H.O. byte
  3882.     dec    cm.bfp+1    ; Adjust H.O. byte
  3883. cmin22: ldx    #cmbuf\        ; Get the address of the command buffer
  3884.     ldy    #cmbuf^        ;        ...
  3885.     jsr    prstr        ; Reprint the command buffer
  3886.     lda    #0        ; Clear the
  3887.     sta    cmaflg        ;    action flag
  3888.     jmp    repars        ; Reparse everything
  3889. cminm3: ldx    cmmres        ;  Move L.O. byte
  3890.     ldy    cmmres+1    ;  Move H.O. byte
  3891.     pla            ; Flush the old comand line pointer
  3892.     pla            ;        ...
  3893.     lda    #0        ;  Reset the failure flag
  3894.     sta    cmcffl        ; 
  3895.     jmp    rskp        ;
  3896. cminm4: cmp    #$60        ; Is this a letter?
  3897.     bmi    cmin41        ; Nope, skip this stuff
  3898.     sec            ; It is, bring it into the proper range
  3899.     sbc    #$27        ;        ...
  3900. cmin41: sec            ; Set carry for subtraction
  3901.     sbc    #$30        ; Make the number unprintable
  3902.     cmp    #0        ; Is the number in the proper range?
  3903.     bmi    cminm5        ; No, give an error
  3904.     cmp    cmbase        ;        ...
  3905.     bmi    cminm6        ; This number is good
  3906. cminm5: pla            ; Restore the old comand line pointer
  3907.     sta    cm.ptr+1    ;        ...
  3908.     sta    cmoptr        ;         ...
  3909.     pla            ;        ...
  3910.     sta    cm.ptr        ;        ...
  3911.     sta    cmoptr        ;         ...
  3912.     lda    cmccnt        ;  Save count in case of <ctrl/H>
  3913.     sta    cmocnt        ;         ...
  3914.     lda    #$FF        ;  Set failure flag
  3915.     sta    cmcffl        ;         ...
  3916.     rts            ; Then return
  3917. cminm6: pha            ; Save the number to add in
  3918.     lda    cmmres+1    ; Move the number to multiply
  3919.     pha            ;     onto the stack for 
  3920.     lda    cmmres        ;    call to mul16
  3921.     pha            ;        ...
  3922.     lda    #0        ; Move base onto the stack (H.O. byte first)
  3923.     pha            ;        ...
  3924.     lda    cmbase        ;        ...
  3925.     pha            ;        ...
  3926.     jsr    mul16        ; Multiply this out
  3927.     pla            ; Get L.O. byte of product
  3928.     sta    cmmres        ; Store it for now
  3929.     pla            ; Get H.O. byte of product
  3930.     sta    cmmres+1    ; Store that too
  3931.     pla            ; Get the digit to add in
  3932.     clc            ; Clear the carry for the add
  3933.     adc    cmmres        ; Add in L.O. byte of result
  3934.     sta    cmmres        ; Store it back
  3935.     lda    cmmres+1    ; Get the H.O. byte
  3936.     adc    #0        ; Add in the carry
  3937.     sta    cmmres+1    ; Save the H.O. byte
  3938.     bcs    cmine2        ; Wrong, we overflowed
  3939.     jmp    cminm1        ; Try for the next digit
  3940. cmine1: ldx    #cmer06\    ; Get the address of the error message
  3941.     ldy    #cmer06^    ;        ...
  3942.     jsr    prstr        ; Print the error
  3943.     jmp    prserr        ; Handle the parse error
  3944. cmine2: ldx    #cmer07\    ; Get the address of the error message
  3945.     ldy    #cmer07^    ;        ...
  3946.     jsr    prstr        ; Print the error message
  3947.     jmp    prserr        ; Handle the error
  3948.  
  3949. .SBTTL    Cmflot - Try to parse a floating point number
  3950.  
  3951. ;
  3952. ;    This routine tries to parse a floating point number in the
  3953. ;    format:
  3954. ;        sd-d.d-dEsddd
  3955. ;
  3956. ;        s is an optional sign bit
  3957. ;        d is a decimal digit
  3958. ;        E is the letter 'E'
  3959. ;        . is a decimal point
  3960. ;
  3961. ;        Input:
  3962. ;
  3963. ;        Output: Cmfltp- 6 byte floating point number
  3964. ;                4.5 byte signed mantissa
  3965. ;                1.5 byte signed exponent
  3966. ;
  3967. ;
  3968. ;        bit    0 1      35 36 37    47
  3969. ;
  3970. ;        Registers destroyed:    A,X,Y
  3971. ;
  3972.  
  3973. cmflot: rts
  3974.  
  3975. .SBTTL    Cmunqs - Try to parse an unquoted string
  3976.  
  3977. ;
  3978. ;    This routine tries to parse an unquoted string terminating
  3979. ;    with one of the break characters in brkwrd.
  3980. ;
  3981. ;        Input:    
  3982. ;
  3983. ;        Output:    X - L.O. byte address of ASCII string
  3984. ;            Y - H.O. byte address of ASCII string
  3985. ;            A - Length of string parsed
  3986. ;
  3987. ;        Registers destroyed:    A,X,Y
  3988. ;
  3989.  
  3990. cmunqs:    lda    cm.ptr        ; Save the command buffer pointer
  3991.     pha            ;        ...
  3992.     lda    cm.ptr+1    ;        ...
  3993.     pha            ;        ...
  3994.     lda    #0        ; Zero length of Atom buffer
  3995.     sta    lenabf        ;        ...
  3996. cmunq1:    jsr    cmgtch        ; Get a character
  3997.     jsr    chkbrk        ; Is it one of the break characters?
  3998.      jmp    cmunq3        ; Yes, handle that condition
  3999.     cmp    #0        ; No, is it an action character?
  4000.     bpl    cmunq2        ; No, handle it as normal text
  4001.     and    #$7F        ; We don't need the H.O. bit
  4002.     cmp    #'?        ; Does the user need help?
  4003.     bne    cmun13        ; Nope, try next possibility
  4004.     jsr    cout        ; Print '?'
  4005.     ldy    #0        ; Zero the action flag
  4006.     sty    cmaflg        ;        ...
  4007.     ldx    #cmin06\    ; Get the help message
  4008.     ldy    #cmin06^    ;        ...
  4009.     jsr    prstr        ;    and print it.
  4010.     jsr    prcrlf        ; Print a crelf after it
  4011.     lda    #cmfehf        ; Check for extra help.
  4012.     bit    cmprmy        ;        ...
  4013.     beq    cmun11        ; If no help, continue
  4014.     jsr    cmehlp        ; Process extra help
  4015. cmun11:    ldx    cm.rty        ; Go reprint prompt
  4016.     ldy    cm.rty+1    ;        ...
  4017.     jsr    prstr        ;        ...
  4018.     sec            ; Adjust buffer pointer
  4019.     lda    cm.bfp        ;        ...
  4020.     sbc    #1        ;        ...
  4021.     sta    cm.bfp        ;        ...
  4022.     bcs    cmun12        ;        ...
  4023.     dec    cm.bfp+1    ; Adjust H.O. byte
  4024. cmun12:    dec    cmccnt        ; Correct character count
  4025.     ldy    #0        ; Stuff a null at end of usable buffer
  4026.     lda    #0        ;        ...
  4027.     sta    (cm.bfp),y    ;        ...
  4028.     ldx    #cmbuf\        ; Reprint command line
  4029.     ldy    #cmbuf^        ;        ...
  4030.     jsr    prstr        ;        ...
  4031.     jmp    cmunq1        ; Go back for more characters
  4032. cmun13:    cmp    #esc        ; Did the user type <esc>?
  4033.     bne    cmunq2        ; No, just stuff the character and cont.
  4034.     lda    #0        ; Clear the action flag
  4035.     sta    cmaflg        ;        ...
  4036.     lda    #cmfdff        ; Check if there is a default value
  4037.     bit    cmprmy        ;        ...
  4038.     beq    cmun14        ; If not, the <esc> loses
  4039.     lda    lenabf        ; Ok, there is a default, but if
  4040.     bne    cmun14        ;    something has been typed, <esc> loses
  4041.     jmp    cmcpdf        ; Go copy default and reparse
  4042. cmun14:    jsr    bell        ; Feep at user
  4043.     sec            ;    and reset the buffer pointer
  4044.     lda    cm.bfp        ;        ...
  4045.     sbc    #1        ;        ...
  4046.     sta    cm.bfp        ;        ...
  4047.     sta    cm.ptr        ;        ...
  4048.     lda    cm.bfp+1    ;        ...
  4049.     sbc    #0        ;        ...
  4050.     sta    cm.bfp+1    ;        ...
  4051.     sta    cm.ptr+1    ;        ...
  4052.     dec    cmccnt        ; Adjust the character count
  4053.     jmp    repars        ;    and reparse the command line
  4054. cmunq2:    ldy    lenabf        ; Fetch where we are in atmbuf
  4055.     sta    atmbuf,y    ;    and store our character there
  4056.     inc    lenabf        ; Reflect increased length
  4057.     jmp    cmunq1        ; Go back for more characters
  4058. cmunq3:    lda    lenabf        ; Get the length
  4059.     beq    cmunqf        ; If we parsed a null string, fail
  4060.     pla            ; Flush old command line pointer
  4061.     pla            ;        ...
  4062.     ldx    #atmbuf\    ; Now, set up the return parameter
  4063.     ldy    #atmbuf^    ;        ...
  4064.     lda    #0        ; Reset the failure flag
  4065.     sta    cmcffl        ;        ...
  4066.     lda    lenabf        ; Set up atom length
  4067.     jmp    rskp        ; Return
  4068. cmunqf:    pla            ; Restore old command line pointer
  4069.     sta    cm.ptr+1    ;        ...
  4070.     sta    cmoptr+1    ;        ...
  4071.     pla            ;        ...
  4072.     sta    cm.ptr        ;        ...
  4073.     sta    cmoptr        ;        ...
  4074.     lda    cmccnt        ; Save count in case of <ctrl/H>
  4075.     sta    cmocnt        ;        ...
  4076.     lda    #$FF        ; Set failure flag
  4077.     sta    cmcffl        ;        ...
  4078.     rts            ; Return
  4079.  
  4080. .SBTTL    Cmtokn - Try to parse for a single character token
  4081.  
  4082. ;
  4083. ;    This routine tries to parse for the character in the X-register.
  4084. ;
  4085. ;        Input:    X - Character to be parsed    
  4086. ;
  4087. ;        Output: +1 - failed to find character
  4088. ;            +4 - success, found character
  4089. ;
  4090. ;        Registers destroyed:    A,X,Y
  4091. ;
  4092.  
  4093. cmtokn:    lda    cm.ptr        ; First, save the old command pointer
  4094.     pha            ;    on the stack
  4095.     lda    cm.ptr+1    ;        ...
  4096.     pha            ;        ...
  4097. cmtk0:    jsr    cmgtch        ; Fetch the next character
  4098.     bpl    cmtk3        ; Not an action character
  4099.     and    #$7F        ; It's an action character
  4100.     cmp    #esc        ; User trying to be lazy?
  4101.     bne    cmtk2        ; Nope, try next option
  4102.     jsr    bell        ; Yes, well, he's not allowed to be lazy
  4103.     lda    #0        ; Clear the action flag
  4104.     sta    cmaflg        ;        ...
  4105.     sec            ; Adjust the buffer pointer back once
  4106.     lda    cm.bfp        ;        ...
  4107.     sbc    #1        ;        ...
  4108.     sta    cm.bfp        ;        ...
  4109.     sta    cm.ptr        ; Copy it into command pointer
  4110.     bcs    cmtk1        ; Need to adjust H.O. byte?
  4111.     dec    cm.bfp+1    ; Yes, do it
  4112. cmtk1:    lda    cm.bfp+1    ; Copy it to command pointer
  4113.     sta    cm.ptr+1    ;        ...
  4114.     dec    cmccnt        ; Adjust the character count
  4115.     jmp    cmtk0        ;    and try again
  4116. cmtk2:    cmp    #'?        ; User need help?
  4117.     bne    cmtk4        ; No, go fail
  4118.     jsr    cout        ; Print it
  4119.     ldx    #cmin07\    ; Point to the information message
  4120.     ldy    #cmin07^    ;        ...
  4121.     jsr    prstr        ;    and print it
  4122.     lda    #dquot        ; Print the character we are looking for
  4123.     jsr    cout        ;    in between double quotes
  4124.     lda    cmprmx        ;        ...
  4125.     jsr    cout        ;        ...
  4126.     lda    #dquot        ;        ...
  4127.     jsr    cout        ;        ...
  4128.     jsr    prcrlf        ; End it with a crelf
  4129.     lda    #cmfehf        ; Load extra help flag
  4130.     bit    cmprmy        ; Test bit
  4131.     beq    cmtknh        ; No extra help
  4132.     jsr    cmehlp        ; Go give extra help
  4133. cmtknh:    ldx    cm.rty        ; Point to prompt
  4134.     ldy    cm.rty+1    ;        ...
  4135.     jsr    prstr        ;    and print it
  4136.     sec            ; Adjust the buffer pointer back one
  4137.     lda    cm.bfp        ;        ...
  4138.     sbc    #1        ;        ...
  4139.     sta    cm.bfp        ;        ...
  4140.     lda    cm.bfp+1    ;        ...
  4141.     sbc    #0        ;        ...
  4142.     sta    cm.bfp+1    ;        ...
  4143.     lda    #0        ; Stuff a null at the end of the buffer
  4144.     ldy    #0        ;        ...
  4145.     sta    (cm.ptr),y    ;        ...
  4146.     ldx    #cmbuf\        ; Point to command buffer
  4147.     ldy    #cmbuf^        ;        ...
  4148.     jsr    prstr        ;    and reprint it
  4149.     lda    #0        ; Clear action flag
  4150.     sta    cmaflg        ;        ...
  4151.     jmp    repars        ;    and go reparse
  4152. cmtk3:    cmp    cmprmx        ; Ok, this either is or is not the
  4153.     bne    cmtk4        ;    char we want. If not, go fail.
  4154.     pla            ; It is, flush the old address
  4155.     pla            ;        ...
  4156.     lda    #0        ; Reset the failure flag
  4157.     sta    cmcffl        ;        ...
  4158.     jmp    rskp        ;    and skip return
  4159. cmtk4:    pla            ; Restore old pointer
  4160.     sta    cm.ptr+1    ;        ...
  4161.     sta    cmoptr+1    ;        ...
  4162.     pla            ;        ...
  4163.     sta    cm.ptr        ;        ...
  4164.     sta    cmoptr        ;        ...
  4165.     lda    cmccnt        ; Save the count for <ctrl/H>
  4166.     sta    cmocnt        ;        ...
  4167.     lda    #$FF        ; Set failure flag
  4168.     sta    cmcffl        ;        ...
  4169.     rts            ; Return
  4170.  
  4171. .SBTTL    Cminbf - read characters from keyboard
  4172.  
  4173. ;
  4174. ;    This routine reads characters from the keyboard until
  4175. ;    an action or editing character comes up.
  4176. ;
  4177. ;        Input:
  4178. ;
  4179. ;        Output:        Cmbuf- characters from keyboard
  4180. ;
  4181. ;        Registers destroyed:
  4182. ;
  4183.  
  4184. cminbf: pha            ; Save the AC
  4185.     txa            ;    and X
  4186.     pha            ;        ...
  4187.     tya            ;    and Y
  4188.     pha            ;        ...
  4189.     php            ; Save the processor status
  4190.     ldy    #0        ; Clear Y
  4191.     lda    cmaflg        ; Fetch the action flag
  4192.     cmp    #0        ; Set??
  4193.     beq    cminb1        ; Nope
  4194.     jmp    cminb9        ; Yes, so leave
  4195. cminb1: inc    cmccnt        ; Up the character count once
  4196.     bne    cminb0        ;  If we are overflowing the command buffer
  4197.     jsr    bell        ;    Feep at the user and do Prserr
  4198.     dec    cmccnt        ;  Make sure this doesn't happen again
  4199.     jmp    prserr        ;    for same string
  4200. cminb0:    jsr    rdkey        ; Get next character from keyboard
  4201. ;    txa            ; [jrd] save x for a bit
  4202. ;    pha            ;  while we translate to ascii
  4203. ;    ldx    char
  4204. ;    lda    attoas,x    ; run it thru the keyboard table
  4205. ;    sta    char
  4206. ;    pla            ; get x back
  4207. ;    tax
  4208. ;    lda    char        ;[31]
  4209.     cmp    #esc        ; esc is a legal non-printing character
  4210.     beq    cminb8
  4211.     cmp    #cr        ; cr is a legal non-printing character
  4212.     beq    cminb8
  4213.     cmp    #lf        ; lf is a legal non-printing character
  4214.     beq    cminb8
  4215.     cmp    #tab        ; tab is a legal non-printing character
  4216.     beq    cminb8
  4217.     cmp    #ctrlu        ; ctrlu is a legal non-printing character
  4218.     beq    cminb8
  4219.     cmp    #ctrlw        ; ctrlw is a legal non-printing character
  4220.     beq    cminb8
  4221.     cmp    #ffd        ; form feed is a legal non-printing character
  4222.     beq    cminb8
  4223.     cmp    #del        ; del is a legal non-printing character
  4224.     beq    cminb8
  4225.     cmp    #bs        ; bs is a legal non-printing character
  4226.     beq    cminb8
  4227.     cmp    #$20        ; ignore non-printing characters
  4228.     bcc    cminb0
  4229.     cmp    #$20+96        ; ignore non-printing characters
  4230.     bcs    cminb0
  4231. cminb8:    cmp    #$7F        ;[46]
  4232.     beq    cmind        ;  Yes
  4233.     cmp    #bs        ;  Also a retry
  4234.     bne    cmnbnh        ;  No, go on
  4235. cmind:    ldx    cmccnt        ;  Check character count
  4236.     cpx    #1        ;  Is this the first character?
  4237.     bne    cmnbnh        ;  Nope, can't help him
  4238.     ldx    cmcffl        ;  Did the previous command fail?
  4239.     bpl    cmnbnh        ;  No, we can't reparse a good command
  4240.     lda    cmoptr        ;  Ok, get the old pointer and set up
  4241.     sta    cm.ptr        ;     the old command line again
  4242.     sta    cm.bfp        ;         ...
  4243.     lda    cmoptr+1    ;         ...
  4244.     sta    cm.ptr+1    ;         ...
  4245.     sta    cm.bfp+1    ;         ...
  4246.     lda    cmocnt        ;  Restore the character count
  4247.     sta    cmccnt        ;         ...
  4248.     lda    #0        ;  Zero this so we can safely use the
  4249.     sta    cmwrk2        ;     code that reprints a line after ^W
  4250.     jmp    cmnbna        ;  Go reprint the line
  4251. cmnbnh:    ldy    #0        ;        ...
  4252.     sta    (cm.bfp),y    ; Stuff it in buffer
  4253.     tax            ; Hold it here for a while
  4254.     clc            ; Clear the carry
  4255.     lda    cm.bfp        ; Increment the buffer pointer
  4256.     adc    #1        ;        ...
  4257.     sta    cm.bfp        ;        ...
  4258.     bcc    cmnb11        ; Carry?
  4259.     inc    cm.bfp+1    ; Yup, do H.O. byte
  4260. cmnb11: txa            ; Get the data back
  4261.     cmp    #ctrlu        ; Is it a ^U
  4262.     bne    cminb2        ; Nope
  4263. cmnb12: jsr    screl2        ; Yes, clear the whole line
  4264.     sec            ;[37] Get the cursor coordinates
  4265.     jsr    ploth        ;[37]        ...
  4266. ;    ldy    #0        ;[DD] Reset cursor position to beg. of line
  4267.     ldx    #0        ;[DD] Reset cursor position to beg. of line
  4268.     clc            ;[DD]        ...
  4269.     jsr    ploth        ;[DD][26]    ...
  4270.     ldx    cm.rty        ;  Get L.O. byte addr of prompt
  4271.     ldy    cm.rty+1    ;     and H.O. byte
  4272.     jsr    prstr        ; Reprint the prompt
  4273.     jsr    screl0        ; Get rid of garbage on that line
  4274.     lda    #cmbuf\        ; Now reset the buffer pointer
  4275.     sta    cm.bfp        ;     to the beginning of the buffer
  4276.     lda    #cmbuf^        ;        ...
  4277.     sta    cm.bfp+1    ;        ...
  4278.     lda    #0        ; Clear AC
  4279.     sta    cmccnt        ; Clear the character count
  4280.     jmp    repars        ; Reparse new line from beginning
  4281. cminb2: cmp    #bs        ; Is it a <bs>?
  4282.     beq    cminb3        ; Yes
  4283.     cmp    #del        ;[46]
  4284.     bne    cminb4        ; No
  4285. cminb3: jsr    scrl        ; move the cursor left
  4286.     jsr    screl0        ; Now clear from there to end of line
  4287.     dec    cmccnt        ; Decrement the character count
  4288.     dec    cmccnt        ;    twice.
  4289.     lda    cmccnt        ; Now fetch it
  4290.     cmp    #0        ; Did we back up too far??
  4291.     bpl    cmnb32        ; No, go on
  4292.     jsr    bell        ; Yes, ring the bell and
  4293.     jmp    cmnb12        ;    go reprint prompt and reparse line
  4294. cmnb32: sec            ; Set the carry
  4295.     lda    cm.bfp        ; Now decrement the buffer pointer
  4296.     sbc    #2        ;    twice.
  4297.     sta    cm.bfp        ; Store it
  4298.     bcs    cmnb33
  4299.     dec    cm.bfp+1    ; Decrement to account for the borrow
  4300. cmnb33: jmp    repars        ; Time to reparse everything
  4301. cminb4:    cmp    #ctrlw        ;  Delete a word?
  4302.     beq    cmnb41        ;  Yes, go take care of that
  4303.     jmp    cmib40        ;  Nope, continue
  4304. cmnb41:    lda    #3        ;  Set up negative offset count
  4305.     sta    cmwrk2        ;         ...
  4306.     sec            ;  Set up to adjust buffer pointer
  4307.     lda    cm.bfp        ;  Get the L.O. byte
  4308.     sbc    #3        ;  Adjust pointer down by 3
  4309.     sta    cm.bfp        ;  Store it back
  4310.     bcs    cmnb42        ;  Don't worry about H.O. byte
  4311.     dec    cm.bfp+1    ;  Adjust H.O. byte also
  4312. cmnb42:    lda    cmwrk2        ;  First, check the count
  4313.     cmp    cmccnt        ;  Cmwrk2 > cmccnt?
  4314.     bmi    cmints        ;  No, go test characters
  4315.     jmp    cmnb12        ;  Yes, go clear the whole line
  4316. cmints:    ldy    #0        ;  Zero Y
  4317.     lda    (cm.bfp),y    ;  Get previous character
  4318.     cmp    #lf        ;  Start to test ranges...
  4319.     bpl    cmits1        ;     Between <lf> and <cr>?
  4320.     jmp    cminac        ;  No, not in range at all
  4321. cmits1:    cmp    #cr+1        ;         ...
  4322.     bmi    cmnb43        ;  Yes, handle it
  4323.     cmp    #space        ;  Between <sp> and '"'?
  4324.     bpl    cmits2        ;  Possible, continue
  4325.     jmp    cminac        ;  No, advance to previous character
  4326. cmits2:    cmp    #dquot+1    ;         ...
  4327.     bmi    cmnb43        ;  Yes, delete back to there
  4328.     cmp    #apos        ;  Between Apostrophy and '/'?
  4329.     bpl    cmits3        ;  Could be, continue
  4330.     jmp    cminac        ;  Nope, advance character
  4331. cmits3:    cmp    #slash+1    ;         ...
  4332.     bmi    cmnb43        ;  Yup, found a delimiter
  4333.     cmp    #colon        ;  Between ':' and '>' perhaps?
  4334.     bpl    cmits4        ;  Maybe
  4335.     jmp    cminac        ;  Nope, advance to previous character    
  4336. cmits4:    cmp    #rabr+1     ;         ...
  4337.     bmi    cmnb43        ;  It is, go delete back to there
  4338.     cmp    #quot        ;  Is it a "'"?
  4339.     bne    cminac        ;  No, advance
  4340. cmnb43:    dec    cmwrk2        ;  Adjust this count
  4341.     clc            ;     and the buffer pointer
  4342.     lda    cm.bfp        ;         ...
  4343.     adc    #1        ;         ...
  4344.     sta    cm.bfp        ;         ...
  4345.     bcc    cmnb44        ;         ...
  4346.     inc    cm.bfp+1    ;         ...
  4347. cmnb44:    lda    cmccnt        ;  Get the command buffer length
  4348. cmnbcc:    sec            ;[37] Get the cursor coordinates
  4349.     jsr    ploth        ;[37]        ...
  4350. ;    sty    savey        ;[37] Save cursor position
  4351.     stx    savex        ;[37] Save cursor position
  4352. ;    cmp    savey        ;[37]  Check against horizontal cursor position
  4353.     cmp    savex        ;[37]  Check against horizontal cursor position
  4354.     bmi    cmnbna        ;  It's smaller, skip vert. cursor adjust
  4355. ;    dex            ;[37]  Adjust cursor vertical position
  4356.     dey            ;[37]  Adjust cursor vertical position
  4357.     pha            ; Save the AC across this call
  4358.     clc            ;[37] Set the cursor to the new position
  4359.     jsr    ploth        ;[26]        ...
  4360.     pla            ; Restore the AC
  4361.     sec            ;  Reflect this in number of characters
  4362.     sbc    #$28        ;     we skipped back over
  4363.     jmp    cmnbcc        ;  Go check again
  4364. cmnbna:    lda    #0        ;  Put a null at the end of the buffer
  4365.     ldy    #0        ;         ...
  4366.     sta    (cm.bfp),y    ;         ...
  4367.     jsr    screl2        ;  Clear current line
  4368.     sec            ;[37] Get the cursor position
  4369.     jsr    ploth        ;[37]        ...
  4370. ;    ldy    #0        ;[EL] Zero the column number
  4371.     ldx    #0        ;[EL] Zero the column number
  4372.     clc            ;[37]        ...
  4373.     jsr    ploth        ;[26]        ...
  4374.     ldx    cm.rty        ;  Reprint prompt
  4375.     ldy    cm.rty+1    ;         ...
  4376.     jsr    prstr        ;         ...
  4377.     ldx    #cmbuf\        ;  Reprint command buffer
  4378.     ldy    #cmbuf^        ;         ...
  4379.     jsr    prstr        ;         ...
  4380.     sec            ;  Now adjust the command character count
  4381.     lda    cmccnt        ;         ...
  4382.     sbc    cmwrk2        ;     by what we have accumulated
  4383.     sta    cmccnt        ;         ...
  4384.     jsr    screl0        ;  Clear to the end of this line
  4385.     jmp    repars        ;  Go reparse the command
  4386. cminac:    inc    cmwrk2        ;  Increment count of chars to back up
  4387.     sec            ;  Adjust the buffer pointer down again
  4388.     lda    cm.bfp        ;         ...
  4389.     sbc    #1        ;         ...
  4390.     sta    cm.bfp        ;         ...
  4391.     bcs    cmnb45        ;  If carry set, skip H.O. byte adjustment
  4392.     dec    cm.bfp+1    ;  Adjust this
  4393. cmnb45:    jmp    cmnb42        ;  Go around once again
  4394.  
  4395. cmib40:    cmp    #quest        ; Need help?
  4396.     beq    cminb6        ;        ...
  4397.     cmp    #esc        ; Is he lazy?
  4398.     beq    cminb6        ;        ...
  4399.     cmp    #cr        ; Are we at end of line?
  4400.     beq    cminb5        ;        ...
  4401.     cmp    #lf        ; End of line?
  4402.     beq    cminb5        ;        ...
  4403.     cmp    #ffd        ; Is it a form feed?
  4404.     bne    cminb7        ; None of the above
  4405.     jsr    scred2        ; clear the screen
  4406.     ldx    #0
  4407.     ldy    #0
  4408.     jsr    scrplt        ; and home the cursor
  4409. cminb5: lda    cmccnt        ; Fetch character count
  4410.     cmp    #1        ; Any characters yet?
  4411.     bne    cminb6        ; Yes
  4412.     jmp    prserr        ; No, parser error
  4413. cminb6: lda    #$FF        ; Go
  4414.     sta    cmaflg        ;    and set the action flag
  4415.     jmp    cminb9        ; Leave
  4416. cminb7:    cmp    #space        ; Is the character a space ?
  4417.     bne    cmnb71        ; No
  4418.     jsr    cout        ; Output the character
  4419.     jmp    cminb1        ; Yes, get another character
  4420. cmnb71:    cmp    #tab        ; Is it a <tab>?
  4421.     bne    cmnb72        ; No
  4422. ;    jsr    cout        ; Output the character
  4423.     jsr    prttab        ;[46]
  4424.     jmp    cminb1        ; Yes, get more characters 
  4425. cmnb72:    jsr    cout        ; Print the character on the screen
  4426.     jmp    cminb1        ; Get more characters
  4427. cminb9: dec    cmccnt        ; Decrement the count once
  4428.     plp            ; Restore the processor status
  4429.     pla            ;    the Y register
  4430.     tay            ;        ...
  4431.     pla            ;    the X register
  4432.     tax            ;        ...
  4433.     pla            ;    and the AC
  4434.     rts            ;    and return!
  4435.  
  4436.  
  4437. .SBTTL    Cmgtch - get a character from the command buffer
  4438.  
  4439. ;
  4440. ;    This routine takes the next character out of the command
  4441. ;    buffer, does some checking (action character, space, etc.)
  4442. ;    and then returns it to the calling program in the AC
  4443. ;
  4444. ;        Input:  NONE
  4445. ;
  4446. ;        Output: A-    Next character from command buffer
  4447. ;
  4448. ;        Registers destroyed:    A,X,Y
  4449. ;
  4450.  
  4451. cmgtch: ldy    #0        ; Y should always be zero here to index buffer
  4452.     lda    cmaflg        ; Fetch the action flag
  4453.     cmp    #0        ; Set??
  4454.     bne    cmgt1        ; Yes
  4455.     jsr    cminbf        ; No, go fetch some more input
  4456. cmgt1:  lda    (cm.ptr),y    ; Get the next character
  4457.     tax            ; Hold on to it here for a moment
  4458.     clc            ; Clear the carry flag
  4459.     lda    cm.ptr        ; Increment
  4460.     adc    #1        ;    the next character pointer
  4461.     sta    cm.ptr        ;        ...
  4462.     bcc    cmgt2        ;        ...
  4463.     inc    cm.ptr+1    ; Have carry, increment H.O. byte
  4464. cmgt2:  txa            ; Now, get the data
  4465.     cmp    #space        ; Space?
  4466.     beq    cmgtc2        ; Yes
  4467.     cmp    #tab        ; <tab>?
  4468.     bne    cmgtc3        ; Neither space nor <tab>
  4469. cmgtc2:    pha            ; Hold the character here till we need it
  4470.     lda    #cmtxt        ; Are we parsing a string?
  4471.     cmp    cmstat        ;         ...
  4472.     beq    cmgtis        ; Yes, ignore space flag test
  4473.     lda    #cmifi        ; Are we parsing a file name?
  4474.     cmp    cmstat        ;        ...
  4475.     beq    cmgtis        ; Yes, ignore the space flag test
  4476.     lda    cmsflg        ; Get the space flag
  4477.     cmp    #0        ; Was the last character a space?
  4478.     beq    cmgtis        ;  No, go set space flag
  4479.     pla            ;  Pop the character off
  4480.     jmp    cmgtch        ;  But ignore it and get another
  4481. cmgtis:    lda    #$FF        ; Set
  4482.     sta    cmsflg        ;    the space flag
  4483.     pla            ;  Restore the space or <tab>
  4484.     jmp    cmgtc5        ; Go return
  4485. cmgtc3: php            ; Save the processor status
  4486.     pha            ; Save this so it doesn't get clobbered
  4487.     lda    #0        ; Clear AC
  4488.     sta    cmsflg        ; Clear space flag
  4489.     pla            ; Restore old AC
  4490.     plp            ; Restore the processor status
  4491.     cmp    #esc        ; Escape?
  4492.     beq    cmgtc5        ;
  4493.     cmp    #quest        ; Need help?
  4494.     beq    cmgtc4        ;
  4495.     cmp    #cr        ; <cr>?
  4496.     beq    cmgtc4        ;
  4497.     cmp    #lf        ; <lf>?
  4498.     beq    cmgtc4        ;
  4499.     cmp    #ffd        ; <ff>?
  4500.     beq    cmgtc4        ;
  4501.     and    #$7F        ; Make sure the character is positive
  4502.     rts            ; Not an action character, just return
  4503. cmgtc4: tax            ; Hold the data
  4504.     sec            ; Set the carry flag
  4505.     lda    cm.ptr        ; Get the next character pointer
  4506.     sbc    #1        ;    and decrement it
  4507.     sta    cm.ptr        ;
  4508.     bcs    cmgtc5        ;
  4509.     dec    cm.ptr+1    ;
  4510. cmgtc5: txa            ; Now, fetch the data
  4511.     ora    #$80        ; Make it look like a terminator
  4512.     rts            ; Go back
  4513.  
  4514. .SBTTL    Prcrlf subroutine - print a crelf
  4515.  
  4516. ;
  4517. ;    This routine sets up a call to prstr pointing to the crlf
  4518. ;    string.
  4519. ;
  4520. ;        Registers destroyed:    A
  4521. ;
  4522. ;
  4523. prcl.0:    txa            ; save x
  4524.     pha
  4525.     tya            ; and y
  4526.     pha
  4527.     lda    #ATEOL        ; get an EOL
  4528. ;    jsr    sputch        ; out it goes
  4529.     jsr    scrput        ; general case, please
  4530.     pla            ; get
  4531.     tay            ;  our
  4532.     pla            ;   bags
  4533.     tax            ;    back
  4534.     rts
  4535. ;
  4536. .SBTTL    Prstr subroutine
  4537.  
  4538. ;
  4539. ;    This routine prints a string ending in a null.
  4540. ;
  4541. ;        Input:  X-    Low order byte address of string
  4542. ;            Y-    High order byte address of string
  4543. ;
  4544. ;        Output:        Prints string on screen
  4545. ;
  4546. ;        Registers destroyed:    A,X,Y
  4547. ;
  4548. ; superceeded by pstrnul 
  4549. ;
  4550. prst.0:    jmp    pstrnul
  4551.  
  4552. ;
  4553. ; jrd removed routine 'dely' (delay 2 ms) here cause it seemed not to 
  4554. ; be used anyplace 
  4555. ; 
  4556.  
  4557. .SBTTL    Mul16 - 16-bit multiply routine
  4558.  
  4559. ;
  4560. ;    This and the following four routines is math support for the
  4561. ;    Comnd package. These routines come from '6502 Assembly Language
  4562. ;    Subroutines' by Lance A. Leventhal. Refer to that source for
  4563. ;    more complete documentation.
  4564. ;
  4565.  
  4566. ml16:    pla            ; Save the return address
  4567.     sta    rtaddr        ;        ...
  4568.     pla            ;        ...
  4569.     sta    rtaddr+1    ;        ...
  4570.     pla            ; Get multiplier
  4571.     sta    mlier        ;        ...
  4572.     pla            ;        ...
  4573.     sta    mlier+1        ;        ...
  4574.     pla            ; Get multiplicand
  4575.     sta    mcand        ;        ...
  4576.     pla            ;        ...
  4577.     sta    mcand+1        ;        ...
  4578.     lda    #0        ; Zero
  4579.     sta    hiprod        ;    high word of product
  4580.     sta    hiprod+1    ;        ...
  4581.     ldx    #17        ; Number of bits in multiplier plus 1, the
  4582.                 ;    extra loop is to move the last carry
  4583.                 ;    into the product.
  4584.     clc            ; Clear carry for first time through the loop
  4585. mullp:  ror    hiprod+1    ; Shift the whole thing down
  4586.     ror    hiprod        ;        ...
  4587.     ror    mlier+1        ;        ...
  4588.     ror    mlier        ;        ...
  4589.     bcc    deccnt        ; Branch if next bit of multiplier is 0
  4590.     clc            ; next bit is 1 so add multiplicand to product
  4591.     lda    mcand        ;        ...
  4592.     adc    hiprod        ;        ...
  4593.     sta    hiprod        ;        ...
  4594.     lda    mcand+1        ;        ...
  4595.     adc    hiprod+1    ;        ...
  4596.     sta    hiprod+1    ; Carry = overflow from add
  4597. deccnt: dex            ;        ...
  4598.     bne    mullp        ; Continue until done
  4599.     lda    mlier+1        ; Get low word of product and push it
  4600.     pha            ;    onto the stack
  4601.     lda    mlier        ;        ...
  4602.     pha            ;        ...
  4603.     lda    rtaddr+1    ; Restore the return address
  4604.     pha            ;        ...
  4605.     lda    rtaddr        ;        ...
  4606.     pha            ;        ...
  4607.     rts            ; Return
  4608.  
  4609. mcand:    ;  .blkb    2        ; Multiplicand
  4610.     .word    0
  4611. mlier:  ;    .blkb    2        ; Multiplier and low word of product
  4612.     .word    0
  4613. hiprod: ;    .blkb    2        ; High word of product
  4614.     .word    0
  4615. rtaddr: ;    .blkb    2        ; Save area for return address
  4616.     .word    0
  4617.  
  4618. .SBTTL    Rskp - Do a skip return
  4619.  
  4620. ;
  4621. ;    This routine returns, skipping the instruction following the
  4622. ;    original call. It is assumed that the instruction following the
  4623. ;    call is a JMP.
  4624. ;
  4625. ;        Input:
  4626. ;
  4627. ;        Output:
  4628. ;
  4629. ;        Registers destroyed:    None
  4630. ;
  4631.  
  4632. rskp.0:    sta    savea        ; Save the registers
  4633.     stx    savex        ;
  4634.     sty    savey        ;
  4635.     pla            ; Get Low order byte of return address
  4636.     tax            ; Hold it
  4637.     pla            ; Get High order byte
  4638.     tay            ; Hold that
  4639.     txa            ; Get Low order byte
  4640.     clc            ; Clear the carry flag
  4641.     adc    #4        ; Add 4 to the address
  4642.     bcc    rskp2        ; No carry
  4643.     iny            ; Increment the high order byte
  4644. rskp2:  sta    saddr        ; Store L.O. byte
  4645.     sty    saddr+1        ; Store H.O. byte
  4646.     lda    savea        ;
  4647.     ldx    savex        ;
  4648.     ldy    savey        ;
  4649.     jmp    (saddr)        ; Jump at the new address
  4650.  
  4651. .SBTTL    Setbrk and Rstbrk
  4652.  
  4653. ;
  4654. ;    These routines are called from the user program to set or reset
  4655. ;    break characters to be used by Cmunqs. The byte to set or reset
  4656. ;    is located in the Accumulator. Rstbrk has the option to reset
  4657. ;    the entire break-word. This occurs if the H.O. bit of AC is on.
  4658. ;
  4659.  
  4660. sbrk.0:    and    #$7F        ; We don't want the H.O. bit
  4661.     ldy    #0        ; Set up Y to index the byte we want
  4662. sbrkts:    cmp    #8        ; Is the offset > 8
  4663.     bmi    sbrkfw        ; No, we are at the right byte now
  4664.     sec            ; Yes, adjust it down again
  4665.     sbc    #8        ;        ...
  4666.     iny            ; Advance index
  4667.     jmp    sbrkts        ;    and try again
  4668. sbrkfw:    tax            ; This is the remaining offset
  4669.     lda    #$80        ; Start with H.O. bit on
  4670. sbrklp:    cpx    #0        ; Is it necessary to shift down?
  4671.     beq    sbrkfb        ; No, we are done
  4672.     dex            ; Yes, adjust offset
  4673.     lsr    a        ; Shift bit down once
  4674.     jmp    sbrklp        ; Go back and try again
  4675. sbrkfb:    ora    brkwrd,y    ; We found the bit, use the byte offset
  4676.     sta    brkwrd,y    ;    from above, set the bit and resave
  4677.     rts            ; Return
  4678.  
  4679. rbrk.0:    asl    a        ; Check H.O. bit
  4680.     bcs    rbrkal        ; If that was on, Zero entire brkwrd
  4681.     lsr    a        ; Else shift back (H.O. bit is zeroed)
  4682. rbrkts:    cmp    #8        ; Are we in the right word?
  4683.     bmi    rbrkfw        ; Yes, go figure the rest of the offset
  4684.     sec            ; No, Adjust the offset down
  4685.     sbc    #8        ;        ...
  4686.     iny            ;    and the index up
  4687.     jmp    rbrkts        ; Try again
  4688. rbrkfw:    tax            ; Stuff the remaining offset in X
  4689.     lda    #$7F        ; Start with H.O. bit off
  4690. rbrklp:    cpx    #0        ; Do we need to offset some more?
  4691.     beq    rbrkfb        ; No, we have the correct bit
  4692.     dex            ; Yes, decrement the offset
  4693.     sec            ; Make sure carry is on
  4694.     ror    a        ;    and rotate a 1 bit into mask
  4695.     jmp    rbrklp        ; Go back and try again
  4696. rbrkfb:    and    brkwrd,y    ; We found the bit, now shut it off
  4697.     sta    brkwrd,y    ;        ...
  4698.     rts            ;    and return
  4699. rbrkal:    lda    #0        ; Go stuff zeros in the entire word
  4700.     ldy    #0        ;        ...
  4701. rbrksz:    sta    brkwrd,y    ; Stuff the zero
  4702.     iny            ; Up the index once
  4703.     cpy    #$10        ; Are we done?
  4704.     bmi    rbrksz        ; Not yet
  4705.     rts            ; Yes, return
  4706.  
  4707. .SBTTL    Chkbrk
  4708.  
  4709. ;
  4710. ;    Chkbrk - This routine looks for the flag in the break word
  4711. ;    which represents the character passed to it. If this bit is
  4712. ;    on, it is a break character and the routine will simply
  4713. ;    return. If it is not a break character, the routine skips..
  4714. ;
  4715.  
  4716. chkbrk:    sta    savea        ; Save byte to be checked
  4717.     and    #$7F        ; Shut H.O. bit
  4718.     ldy    #0        ; Zero this index
  4719. cbrkts:    cmp    #8        ; Are we at the right word?
  4720.     bmi    cbrkfw        ; Yes, go calculate bit position
  4721.     sec            ; No, adjust offset down
  4722.     sbc    #8        ;        ...
  4723.     iny            ; Increment the index
  4724.     jmp    cbrkts        ; Go back and test again
  4725. cbrkfw:    tax            ; Stuff the remaining offset in X
  4726.     lda    #$80        ; Set H.O. bit on for testing
  4727. cbrklp:    cpx    #0        ; Are we in position yet?
  4728.     beq    cbrkfb        ; Yes, go test the bit
  4729.     dex            ; No, decrement the offset
  4730.     lsr    a        ;    and adjust the bit position
  4731.     jmp    cbrklp        ; Go and try again
  4732. cbrkfb:    and    brkwrd,y    ; See if the bit is on
  4733.     bne    cbrkbc        ; It is a break character
  4734.     lda    savea        ; Restore the character
  4735.     jmp    rskp        ; Not a break character, skip return
  4736. cbrkbc:    lda    savea        ; Restore the character
  4737.     rts            ; Return
  4738.  
  4739. .SBTTL    Cmehlp - Do extra help on Question-mark prompting
  4740.  
  4741. ;
  4742. ;    Cmehlp - This routine uses a string of commands passed to it
  4743. ;    in order to display alternate valid parse types to the user.
  4744. ;
  4745. ;        Input:    Cmehpt-    Pointer to valid parse types (end in 00)
  4746. ;
  4747. ;        Output:    Display on screen, alternate parse types
  4748. ;
  4749. ;        Registers destroyed:    A,X,Y
  4750. ;
  4751.  
  4752. cmehlp:    lda    cmstat        ; We are going to need this so
  4753.     pha            ;    save it across the call
  4754.     ldy    #0        ; Zero out the help index
  4755.     sty    cmehix        ;        ...
  4756. cmehl1:    ldy    cmehix        ; Load the extra help index
  4757.     lda    (cmehpt),y    ; Fetch next type
  4758.     sta    cmstat        ; Store it here
  4759.     inc    cmehix        ; Increase the index by one
  4760.     cmp    #0        ; Is the type null?
  4761.     bne    cmeh0        ; No, continue
  4762.     jmp    cmehrt        ; Yes, terminate
  4763. cmeh0:    cmp    #cmtok+1    ; If the type is out of range, leave
  4764.     bmi    cmeh1        ;        ...
  4765.     jmp    cmehrt        ;        ...
  4766. cmeh1:    pha            ; Save the type across the call
  4767.     ldx    #cmors\        ; Set up address of 'OR ' string
  4768.     ldy    #cmors^        ;        ...
  4769.     jsr    prstr        ;    and print it
  4770.     pla            ; Restore AC
  4771.     cmp    #cmkey        ; Compare with keyword
  4772.     bne    cmeh2        ; No, try next type
  4773. cmeh10:    tax            ; Hold type in X register
  4774.     lda    cmsptr        ; Save these parms so they can be restored
  4775.     pha            ;        ...
  4776.     lda    cmsptr+1    ;        ...
  4777.     pha            ;        ...
  4778.     lda    cm.ptr        ; Copy the pointer to the saved pointer
  4779.     sta    cmsptr        ;    so the keyword print routine prints
  4780.     pha            ;    the entire table. Also, save it on
  4781.     lda    cm.ptr+1    ;    the stack so it can be restored later
  4782.     sta    cmsptr+1    ;        ...
  4783.     pha            ;        ...
  4784.     lda    cmptab        ; Save the table address also
  4785.     pha            ;        ...
  4786.     lda    cmptab+1    ;        ...
  4787.     pha            ;        ...
  4788.     txa            ; Restore type
  4789.     cmp    #cmkey        ; Keyword?
  4790.     bne    cmeh11        ; No, it must be a switch table
  4791.     ldx    #cmin01\    ; Set up address of message
  4792.     ldy    #cmin01^    ;        ...
  4793.     jmp    cmeh12        ; Go print the string
  4794. cmeh11:    ldx    #cmin02\    ; Set up address of 'switch' string
  4795.     ldy    #cmin02^    ;        ...
  4796. cmeh12:    jsr    prstr        ; Print the message
  4797.     ldy    cmehix        ; Get the index into help string
  4798.     lda    (cmehpt),y    ; Fetch L.O. byte of table address
  4799.     sta    cmptab        ; Set that up for Cmktp
  4800.     iny            ; Increment the index
  4801.     lda    (cmehpt),y    ; Get H.O. byte
  4802.     sta    cmptab+1    ; Set it up for Cmktp
  4803.     iny            ; Advance the index
  4804.     sty    cmehix        ;    and store it
  4805.     jsr    cmktp        ; Print the keyword table
  4806.     pla            ; Now restore all the stuff we saved before
  4807.     sta    cmptab+1    ;        ...
  4808.     pla            ;        ...
  4809.     sta    cmptab        ;        ...
  4810.     pla            ;        ...
  4811.     sta    cm.ptr+1    ;        ...
  4812.     pla            ;        ...
  4813.     sta    cm.ptr        ;        ...
  4814.     pla            ;        ...
  4815.     sta    cmsptr+1    ;        ...
  4816.     pla            ;        ...
  4817.     sta    cmsptr        ;        ...
  4818.     jmp    cmehl1        ; See if there is more to do
  4819. cmeh2:    cmp    #cmswi        ; Type is switch?
  4820.     bne    cmeh3        ; No, continue
  4821.     jmp    cmeh10        ; We can treat this just like a keyword
  4822. cmeh3:    cmp    #cmifi        ; Input file?
  4823.     bne    cmeh4        ; No, go on
  4824.     ldx    #cmin03\    ; Set up the message address
  4825.     ldy    #cmin03^    ;        ...
  4826.     jmp    cmehps        ; Go print it
  4827. cmeh4:    cmp    #cmofi        ; Output file?
  4828.     bne    cmeh5        ; Nope, try again
  4829.     ldx    #cmin04\    ; Set up message address
  4830.     ldy    #cmin04^    ;        ...
  4831.     jmp    cmehps        ; Go print the string
  4832. cmeh5:    cmp    #cmcfm        ; Confirm?
  4833.     bne    cmeh6        ; No
  4834.     ldx    #cmin00\    ; Set up address
  4835.     ldy    #cmin00^    ;        ...
  4836.     jmp    cmehps        ; Print the string
  4837. cmeh6:    cmp    #cmtxt        ; Unquoted string?
  4838.     bne    cmeh7        ; No, try next one
  4839.     ldx    #cmin06\    ; Set up address
  4840.     ldy    #cmin06^    ;        ...
  4841.     jmp    cmehps        ; Print
  4842. cmeh7:    cmp    #cmnum        ; Integer?
  4843.     bne    cmeh8        ; Try again
  4844.     ldx    #cmin05\    ; Set up message
  4845.     ldy    #cmin05^    ;        ...
  4846.     jsr    prstr        ; Print it
  4847.     ldy    cmehix        ; Get index
  4848.     inc    cmehix        ; Advance index
  4849.     lda    (cmehpt),y    ; Get base of integer
  4850.     cmp    #$0A        ; Is it greater than decimal 10?
  4851.     bmi    cmeh71        ; No, just print the L.O. digit
  4852.     lda    #$31        ; Print the H.O. digit as a 1
  4853.     jsr    cout        ; Print the '1'
  4854.     ldy    cmehix        ; Load index
  4855.     dey            ; Point back to last byte
  4856.     lda    (cmehpt),y    ; Get the base back
  4857.     sec            ; Set the carry flag for subtraction
  4858.     sbc    #$0A        ; Subtract off decimal 10
  4859. cmeh71:    clc            ; Clear carry for addition
  4860.     adc    #$30        ; Make it printable
  4861.     jsr    cout        ; Print the digit
  4862.     jsr    prcrlf        ; Print a crelf
  4863.     jsr    prbyte        ; Print the byte
  4864.     jmp    cmehl1        ; Go back for more
  4865. cmeh8:    ldx    #cmin07\    ; Assume it's a token
  4866.     ldy    #cmin07^    ;        ...
  4867. cmehps:    jsr    prstr        ; Print string
  4868.     jsr    prcrlf        ; Print a crelf
  4869.     jmp    cmehl1        ; Go back
  4870. cmehrt:    pla            ; Restore
  4871.     sta    cmstat        ;    current parse type
  4872.     rts
  4873.  
  4874. .SBTTL    Cmcpdf - Copy a default string into the command buffer
  4875.  
  4876. ;
  4877. ;    Cmcpdf - This routine copies a default for a field
  4878. ;    into the command buffer andreparses the string.
  4879. ;
  4880. ;        Input:    Cmdptr-    Pointer to default field value (asciz)
  4881. ;
  4882. ;        Output:
  4883. ;
  4884. ;        Registers destroyed:    A,X,Y
  4885. ;
  4886.  
  4887. cmcpdf:    sec            ; Reset the buffer pointer
  4888.     lda    cm.bfp        ;        ...
  4889.     sbc    #1        ;        ...
  4890.     sta    cm.bfp        ;        ...
  4891.     bcs    cmcpst        ; If carry set, don't adjust H.O. byte
  4892.     dec    cm.bfp+1    ;        ...
  4893. cmcpst:    dec    cmccnt        ; Adjust the character count
  4894.     ldy    #0        ; Zero the index
  4895. cmcplp:    lda    (cmdptr),y    ; Get byte
  4896.     beq    cmcpdn        ; Copy finished, leave
  4897.     ldx    cmccnt        ; Check character count
  4898.     inx            ; If it is just short of wrapping
  4899.     bne    cmcpl1        ;    then we are overflowing buffer
  4900.     jsr    bell        ; If that is the case, tell the user
  4901.     dec    cmccnt        ; Make sure it doesn't happen again
  4902.     jmp    prserr        ;    for same string.
  4903. cmcpl1:    
  4904.     ora    #$80        ; Be consistent, make sure H.O. bit is on
  4905.     sta    (cm.bfp),y    ; Stuff it in the buffer
  4906.     inc    cmccnt        ; Adjust character count
  4907.     iny            ; Up the buffer index
  4908.     jmp    cmcplp        ; Go to top of loop
  4909. cmcpdn:    lda    #space        ; Get a space
  4910.     sta    (cm.bfp),y    ;    and place it in buffer after keyword
  4911.     iny            ; Increment the buffer index
  4912.     lda    #nul        ; Get a null
  4913.     sta    (cm.bfp),y    ;    and stuff that at the end of buffer
  4914.     clc            ; Now recompute the end of usable buffer
  4915.     tya            ; Get the number of chars added
  4916.     adc    cm.bfp        ; Add that to the buffer pointer
  4917.     sta    cm.bfp        ;        ...
  4918.     lda    #0        ;        ...
  4919.     adc    cm.bfp+1    ;        ...
  4920.     sta    cm.bfp+1    ;        ...
  4921.     lda    #0        ; Reset the action flag
  4922.     sta    cmaflg        ;        ...
  4923.     sec            ; Now adjust the command pointer to the
  4924.     lda    cm.ptr        ;    beginning of the copied field
  4925.     sbc    #1        ;        ...
  4926.     tax            ; Set it up in X and Y so we can call Prstr
  4927.     lda    cm.ptr+1    ;        ...
  4928.     sbc    #0        ;        ...
  4929.     tay            ;        ...
  4930.     jsr    prstr        ; Print the added field
  4931.     jmp    repars        ; Now go reparse the whole command
  4932.  
  4933. .SBTTL    Comnd Jsys messages and table storage
  4934.  
  4935. cmer00: .byte    cr,"?program error:  invalid comnd call",0        ; [53]
  4936. cmer01: .byte    cr,"?ambiguous",0        ; [53]
  4937. cmer02: .byte    cr,"?illegal input file spec",0        ; [53]
  4938. cmer03: .byte    cr,"?no keywords match this prefix",0        ; [53]
  4939. cmer04: .byte    cr,"?no switches match this prefix",0        ; [53]
  4940. cmer05: .byte    cr,"?bad character in integer number",0        ; [53]
  4941. cmer06: .byte    cr,"?base of integer out of range",0        ; [53]
  4942. cmer07: .byte    cr,"?overflow while reading integer number",0        ; [53]
  4943.  
  4944. cmin00: .byte    " confirm with RETURN",0        ; [53]
  4945. cmin01: .byte    " keyword, one of:",0        ; [53]
  4946. cmin02: .byte    " switch, one of:",0        ; [53]
  4947. cmin03: .byte    " input file spec",0        ; [53]
  4948. cmin04: .byte    " output file spec",0        ; [53]
  4949. cmin05: .byte    " integer number in base ",0        ; [53]
  4950. cmin06:    .byte    " unquoted text string ",0        ; [53]
  4951. cmin07:    .byte    " single character token ",0        ; [53]
  4952.  
  4953. cmors:    .byte    " or ",0        ; [53]
  4954.  
  4955. .SBTTL    Kermit defaults for operational parameters
  4956.  
  4957. ;
  4958. ;    The following are the defaults which this Kermit uses for
  4959. ;    the protocol.
  4960. ;
  4961.  
  4962. dquote  =    '#        ; The quote character
  4963. dpakln  =    94        ; The packet length
  4964. dpadch  =    nul        ; The padding character
  4965. dpadln  =    0        ; The padding length
  4966. dmaxtr  =    20        ; The maximum number of tries
  4967. debq    =    '&        ; The eight-bit-quote character
  4968. ;dtime    =    15        ; The default time-out amount
  4969. dtime    =    5        ; [jrd] 5 sec ought to be ok
  4970. deol    =    cr        ; The end-of-line character
  4971.  
  4972. .SBTTL    Kermit data
  4973.  
  4974. ;
  4975. ;    The following is data storage used by Kermit
  4976. ;
  4977.  
  4978. mxpack  =    dpakln        ; Maximum packet size
  4979. mxfnl    =    16        ; Maximum file-name len, "Dn:FROBBOZZ.DAT"
  4980. eof    =    $01        ; This is the value for End-of-file
  4981. buflen  =    $FF        ; Buffer length for received data
  4982. true    =    $01        ; Symbol for true return code
  4983. false    =    $00        ; Symbol for false return code
  4984. on    =    $01        ; Symbol for value of 'on' keyword
  4985. off    =    $00        ; Symbol for value of 'off' keyword
  4986. yes    =    $01        ; Symbol for value of 'yes' keyword
  4987. no    =    $00        ; Symbol for value of 'no' keyword
  4988. terse    =    $01        ; Symbol for terse debug mode
  4989. verbose    =    $02        ; Symbol for verbose debug mode
  4990. xon    =    $11        ; Xon for Ibm-mode
  4991. fbsbit  =    $01        ; Value for SEVEN-BIT FILE-BYTE-SIZE
  4992. fbebit  =    $00        ; Value for EIGHT-BIT FILE-BYTE-SIZE
  4993. nparit    =    $00        ; Value for PARITY NONE
  4994. sparit    =    $01        ; Value for PARITY SPACE
  4995. mparit    =    $02        ; Value for PARITY MARK
  4996. oparit    =    $03        ; Value for PARITY ODD
  4997. eparit    =    $04        ; Value for PARITY EVEN
  4998. ;
  4999. ; NB! these values are internal codes, which should be
  5000. ;  sequential from 0.  The real values for the port are 
  5001. ;  in bdval, indexed by these values
  5002. ;
  5003. bd50    =    $00        ;[17] Value for BAUD 50
  5004. bd75    =    $01        ;[17]
  5005. bd110    =    $02        ;[17] Value for BAUD 110
  5006. bd150    =    $03        ;[17] Value for BAUD 150
  5007. bd300    =    $04        ;[17] Value for BAUD 300
  5008. bd1200    =    $05        ;[17] Value for BAUD 1200
  5009. bd1800    =    $06        ;[17] Value for BAUD 1800
  5010. bd2400    =    $07        ;[17] Value for BAUD 2400
  5011. bd4800    =    $08        ;[17] Value for BAUD 4800
  5012. bd9600    =    $09        ;[17] Value for BAUD 9600
  5013. ;
  5014. ; defs for values in errcod
  5015. ;
  5016. eprflg    =    $40        ;    'Error packet received' flag
  5017. edoflg    =    $80        ;    Dos error code
  5018. ;
  5019. errcri  =    $01        ; Error code - cannot receive init
  5020. errcrf  =    $02        ; Error code - cannot receive file-header
  5021. errcrd  =    $03        ; Error code - cannot receive data
  5022. errmrc  =    $04        ; Error code - maximum retry count exceeded
  5023. errbch  =    $05        ; Error code - bad checksum
  5024. errint    =    $06        ; [jrd] internal error
  5025. errfta    =    $07        ; [jrd] transfer aborted
  5026. errfal    =    $08        ; [jrd] filename alter error
  5027. errfae  =    $09        ; Error code - file already exists
  5028. errfde    =    $0A        ; [jrd] some DOS (typically disk) error
  5029. ;
  5030. ;emesln  =    $19        ; Standard error message length
  5031. kerrns  =    $1F        ; Routine name and action string length
  5032. ;kerdel  =    $15        ; Disk error length
  5033. kerems  =    $19        ; Error message size
  5034. kerfts    =    $08        ; Size of file-type strings (incl. term. nul)
  5035. kerdsz    =    $09        ; Length of debug mode strings
  5036. kerpsl    =    $06        ; Size of parity strings
  5037. kerbsl    =    $05        ;[17] Size of baud strings
  5038. keremu    =    $06        ; size of terminal emulation strings
  5039. kerfrm    =    cminf1        ; 'From string' pointer for Kercpy routine
  5040. kerto    =    cminf2        ; 'To string' pointer for Kercpy routine
  5041.  
  5042. errrkm:    .blkb    mxpack-2    ; Error message from remote Kermit
  5043. pdbuf:  .blkb    mxpack-2    ; Packet buffer
  5044. plnbuf: .blkb    $100        ;[DD] Port line buffer
  5045. pdlen:  .byte    0        ; Common area to place data length
  5046. ptype:  .byte    0        ; Common area to place current packet type
  5047. pnum:    .byte    0        ; Common area to put packet number received
  5048. pdtend: .byte    0        ; End of plnbuf pointer
  5049. pdtind: .byte    0        ; Index for plnbuf
  5050. rstat:  .byte    0        ; Return status
  5051. kerrta: .word    0        ; Save area for return address
  5052. datind: .byte    0        ; Data index into packet buffer
  5053. chebo:  .byte    0        ; Switch to tell if 8th-bit was on
  5054. escflg: .byte    0        ; Flag indicating we have seen an escape ($1b)
  5055. addlf:  .byte    0        ; Add a <lf> flag
  5056. dellf:  .byte    0        ; Flush a <lf> flag
  5057. jtaddr: .word    0        ; Jump table address hold area
  5058. ;hch:    .byte    0        ; Hold area for ch
  5059. ;hcv:    .byte    0        ; Hold area for cv
  5060. kwrk01: .byte    0        ; Work area for Kermit
  5061. kwrk02: .byte    0        ; Work area for Kermit
  5062. kertpc:    .byte    0        ; Hold area for parity check
  5063. ksavea:    .byte    0        ; Save area for accumulator
  5064. ksavex:    .byte    0        ; Save area for X reg
  5065. ksavey:    .byte    0        ; Save area for Y reg
  5066. kerchr: .byte    0        ; Current character read off port
  5067. kermbs: .word    0        ; Base address of message table
  5068. debchk: .byte    0        ; Checksum for debug routine
  5069. debinx: .byte    0        ; Debug routine action index
  5070. fld:    .byte    0        ; State of receive in rpak routine
  5071. retadr: .word    0        ; Hold area for return address
  5072. n:    .byte    0        ; Message #
  5073. numtry: .byte    0        ; Number of tries for this packet
  5074. oldtry: .byte    0        ; Number of tries for previous packet
  5075. maxtry: .byte    dmaxtr        ; Maximum tries allowed for a packet
  5076. state:  .byte    0        ; Current state of system
  5077. local:    .byte    0        ; Local/Remote switch
  5078. size:    .byte    0        ; Size of present data
  5079. chksum: .byte    0        ; Checksum for packet
  5080. rtot:    .word    0        ; Total number of characters received
  5081. stot:    .word    0        ; Total number of characters sent
  5082. rchr:    .word    0        ; Number characters received, current file
  5083. schr:    .word    0        ; Number of characters sent, current file
  5084. rovr:    .word    0        ; Number of overhead characters on receive
  5085. sovr:    .word    0        ; Number of overhead characters on send
  5086. tpak:    .word    0        ; Number of packets for this transfer
  5087. eofinp: .byte    0        ; End-of-file (no characters left to send)
  5088. eodind: .byte    0        ; End-of-data reached on disk
  5089. errcod: .byte    0        ; Error indicator
  5090. ;errrkm:    .blkb    mxpack-2    ; Error message from remote Kermit
  5091. kerosp: .byte    0        ; Save area for stack pointer
  5092. keresp:    .byte    0        ; [jrd] another one for exit time
  5093. kerret:    .word    0        ; [jrd] return address for exit in case
  5094.                 ;  stack trashed
  5095.  
  5096. ;
  5097. ; equates for terminal types
  5098. ;
  5099. ttnone    =    0        ; terminal type none, glass tty
  5100. tt52    =    1        ; vt52
  5101. tt100    =    2        ; vt100
  5102.  
  5103. ;
  5104. ; equates for character set designators.  See csg0, csg1 for use
  5105. ;
  5106. csascii    =    0        ; normal ascii font
  5107. csgraf    =    1        ; graphics font
  5108.  
  5109. ;
  5110. ; equates for file types.  NB! the code assumes all text types
  5111. ; are less than all binary types, and that "binary" is the first
  5112. ; binary type.
  5113. ;
  5114. ftstas    =    0        ; Standard ascii
  5115. ftatas    =    1        ; Atari ASCII
  5116. ftbin    =    2        ; binary
  5117.  
  5118. ;
  5119. ; equates for screen types
  5120. ;
  5121. scrae    =    0        ; Atari E:
  5122. scr40    =    1        ; 40 col visible, pannable to 80
  5123. scr80    =    2        ; 80 col, using highest res graphics
  5124. ;
  5125. scrtype: .byte    scrae        ; Use the Atari E: screen for starters
  5126. ;
  5127. ; This block of stuff (escp .. quote) gets saved and restored.
  5128. ;
  5129. escp:    .byte    $19        ; Character for escape from connection
  5130. ;fbsize: .byte    fbsbit        ; File-byte-size
  5131. capslck: .byte    0        ; [jrd] caps lock, default off
  5132. filmod: .byte    ftatas        ; Current file type, default atascii
  5133. usehdr: .byte    off        ; Switch - where to get filename (on=file-head)
  5134. lecho:  .byte    off        ; Local-echo switch
  5135. ibmmod: .byte    off        ; Ibm-mode switch
  5136. vtmod:  .byte    tt100        ; VT-52 Emulation mode switch, default off
  5137. conscrt: .byte    scr80        ; screen to use in terminal mode.  Default 80
  5138. parity: .byte    nparit        ; Parity setting
  5139. baud:    .byte    bd1200        ;[17] Baud setting
  5140. wrdsiz:    .byte    fbebit        ;[17] Word length setting
  5141. flowmo:    .byte    off        ;[24] Flow-Control switch
  5142. delay:  .byte    0        ; Amount of delay before first send
  5143. filwar: .byte    off        ; File-warning switch
  5144. debug:  .byte    off        ; Debug switch
  5145. ebqmod: .byte    off        ; Eight-bit-quoting mode
  5146. ; parameters for the XIO 36 (set baud rate etc] call in openrs
  5147. x36ax1:    .byte    $0A        ; [jrd] the AUX1 value for the XIO 36.  1200 bps default
  5148. x38ax1:    .byte    $00        ; [jrd] the AUX1 value for the XIO 38.  no parity default
  5149.  
  5150. ;
  5151. ;    These fields are set parameters and should be kept in this
  5152. ;    order to insure integrity when setting and showing values
  5153. ;
  5154.  
  5155. srind:  .byte            ; Switch to indicate which parm to print
  5156. ebq:    .byte    debq        ; Eight-bit quote character (rec. and send)
  5157.     .byte    debq        ;        ...
  5158. pad:    .byte    dpadln        ; Number of padding characters (rec. and send)
  5159.     .byte    dpadln        ;        ...
  5160. padch:  .byte    dpadch        ; Padding character (receive and send)
  5161.     .byte    dpadch
  5162. eol:    .byte    deol        ; End-of-line character (recevie and send)
  5163.     .byte    deol
  5164. psiz:    .byte    dpakln        ; Packet size (receive and send)
  5165.     .byte    dpakln
  5166. time:    .byte    dtime        ; Time-out interval (receive and send)
  5167.     .byte    dtime        ;
  5168. quote:  .byte    dquote        ; Quote character (receive and send)
  5169.     .byte    dquote        ;        ...
  5170.  
  5171. ;ttime:    .word    $0000        ;[49] Time out interval (receive and send)
  5172. ttime:    .word    $0000        ; [jrd] recv/send Timer expiration time, hi,lo
  5173.  
  5174. ;
  5175. ;    Some definitions to make life easier when referencing the above
  5176. ;    fields.
  5177. ;
  5178.  
  5179. rebq    =    ebq        ; Receive eight-bit-quote char
  5180. sebq    =    ebq+1        ; Send eight-bit-quote char
  5181. rpad    =    pad        ; Receive padding amount
  5182. spad    =    pad+1        ; Send padding amount
  5183. rpadch    =    padch        ; Receive padding character
  5184. spadch    =    padch+1        ; Send padding character
  5185. reol    =    eol        ; Receive end-of-line character
  5186. seol    =    eol+1        ; Send end-of-line character
  5187. rpsiz    =    psiz        ; Receive packet length
  5188. spsiz    =    psiz+1        ; Send packet length
  5189. rtime    =    time        ; Receive time out interval
  5190. stime    =    time+1        ; Send time out interval
  5191. rquote    =    quote        ; Receive quote character
  5192. squote    =    quote+1        ; Send quote character
  5193.  
  5194. .SBTTL    Kermit - CBM DOS support
  5195.  
  5196. ;
  5197. ;    The following definitions and storage will be used when setting
  5198. ;    up and executing calls to the DOS.
  5199. ;
  5200.  
  5201. fncrea  =    'R        ; Read function code
  5202. fncwrt  =    'W        ; Write function code
  5203. drdoll    =    '$        ;[40] Directory string
  5204. drcolo    =    ':        ;[40]
  5205. drstar    =    '*        ;[40]
  5206. ; [jrd] not here you don't
  5207. ;kerfcb    =    $1e        ; Pointer to FCB
  5208. ;buff    =    $200        ; Temp disk char read
  5209. ;buff:    .byte    0
  5210. ;fmrcod: .byte    0        ; Disk status return code
  5211. decnum:    .word            ; [54] Number being converted to decimal
  5212. ;dskers: .blkb    110        ; Storage for disk error messages
  5213. dosffm:    .byte    $00        ; 'First file modification done' switch
  5214. ;dosfni:    .byte    $00        ; Filename index
  5215. dosfvn:    .byte    $00        ; File version number for the alter routine
  5216. ;
  5217. ; pathname descriptors
  5218. ;
  5219. primfn: .blkb    mxfnl+mxfnl+1    ; File name for local opens
  5220.                 ;  double size for renames...
  5221.     .byte    0        ; sanity check...
  5222. fcb1:    .blkb    mxfnl+1        ; buffer for typing names into
  5223.     .byte    0        ; sanity check...
  5224. ;
  5225. ; the default pathname
  5226. ;
  5227. defpath:
  5228.     .byte    pnf.dp!pnf.np!pnf.ep ; contains, dev, name, and type
  5229.     .byte    2        ; dev max
  5230.     .byte    2,"D1"        ; dev size, text
  5231.     .byte    8        ; name max
  5232.     .byte    3,"FOO     "    ; name size, text
  5233.     .byte    3        ; ext max
  5234.     .byte    3,"DAT"        ; ext size, text
  5235. ;
  5236. wildfn:    .byte    "*.*",0        ; wild file name, for defaults in cp
  5237. ;
  5238. dsknum    =    defpath+4    ; address of the '1'
  5239. ;
  5240. ;path:    .blkb    pndsiz        ; one for random pathnames that come in
  5241. path:                ; one for random pathnames that come in
  5242.     .byte    0        ; flags
  5243.     .byte    2,0,0,0
  5244.     .byte    8,0,0,0,0,0,0,0,0,0
  5245.     .byte    3,0,0,0,0
  5246. ;
  5247. dirpath:            ; one for directory entries
  5248.     .byte    0        ; flags
  5249.     .byte    2,0,0,0
  5250.     .byte    8,0,0,0,0,0,0,0,0,0
  5251.     .byte    3,0,0,0,0
  5252. ;
  5253. dirplck: .byte    0        ; 'locked' flag for current dirpath
  5254. dirsect: .byte    "    ",ATEOL    ; buf for sector count strg
  5255. ;
  5256. ;
  5257. flsrw:  .byte    0        ; Switch for r(ead) or w(rite)
  5258. ;
  5259. prmt:    .byte    "Kermit-65>"    ; Prompting text
  5260.     .byte    0        ; [53]
  5261. lprmt    =    .-prmt        ; Length of prompting text
  5262. connec:    .byte    $00        ;[48] non-zero if in terminal mode
  5263.  
  5264.  
  5265. .SBTTL    Kermit initialization
  5266.  
  5267. ;
  5268. ;    The following code sets up Kermit-65 for normal operation.
  5269. ;    This is the main entry point.  There is currently no warmstart
  5270. ;    entry point.
  5271. ;
  5272. kstart:    
  5273.     pla            ; [jrd] save return address
  5274.     sta    kerret        ;  for exit time
  5275.     pla
  5276.     sta    kerret+1
  5277.     tsx            ; save SP too
  5278.     stx    keresp
  5279. ;
  5280.     jsr    openscr        ; [jrd] open screen, so we can talk to user.
  5281. ; [jrd]    jsr    clall        ;[] First close all open channels
  5282. ; [jrd]    jsr    ioinit        ;[16] Initialize I/O devices
  5283. ; [jrd]    jsr    restoi
  5284. ;     jsr    scrini        ; [jrd] zzz what should this be here?
  5285. ; [jrd]    lda    r6510        ;[17] Start by paging out BASIC ROM
  5286. ; [jrd]    and    #$fe        ;[17]        ...
  5287. ; [jrd]    sta    r6510        ;[17]        ...
  5288. ;
  5289.     jsr    restin        ; try to read and parse init file
  5290.  
  5291. init:
  5292. ;
  5293. ; fix margins
  5294. ;
  5295.     lda    #0
  5296.     sta    LMARGN
  5297. ;
  5298. ; 4/11/90 jrd.  Don't frob with right margin, so as not to screw up
  5299. ; XEP 80 support.  This means we'll lose big if something else has
  5300. ; screwed it up already.  BFD...
  5301. ;
  5302. ;    lda    #39
  5303. ;    sta    RMARGN
  5304. ;
  5305.     jsr    dopari        ;[]
  5306.     jsr    dobad        ;[]
  5307.     jsr    dowrd        ;[]
  5308.     ldx    #versio\    ;Get address of version message
  5309.     ldy    #versio^    ;        ...
  5310.     jsr    prstr        ;Print the version
  5311.     jsr    prcrlf        ;Print a crlf
  5312. ;    jsr    kermit        ;Go execute kermit
  5313.     jsr    kerm        ; [jrd] Go execute kermit
  5314.     jmp    exit1        ;[17] and reenter BASIC
  5315.  
  5316. ;
  5317. ; debug stack stuff
  5318. ;
  5319. ;dbgstk:
  5320. ;    jsr    prstr        ; print the string
  5321. ;    tsx
  5322. ;    stx    freemem        ; temp
  5323. ;    txa
  5324. ;    jsr    prbyte
  5325. ;    lda    #':
  5326. ;    jsr    prchr
  5327. ;    lda    #16
  5328. ;    sta    freemem+1
  5329. ;dbgstk1:
  5330. ;    ldx    freemem
  5331. ;    lda    $100,x
  5332. ;    inx
  5333. ;    stx    freemem
  5334. ;    jsr    prbyte
  5335. ;    lda    #space
  5336. ;    jsr    prchr
  5337. ;    dec    freemem+1
  5338. ;    bne    dbgstk1
  5339. ;    jsr    prcrlf
  5340. ;    rts
  5341.  
  5342. .SBTTL    Kermit - main routine
  5343.  
  5344. ;
  5345. ;    This routine is the main KERMIT loop. It prompts for commands
  5346. ;    and then it dispatches to the appropriate routine.
  5347. ;
  5348. ;kmtxt:    .byte    ATEOL,"Main ",0
  5349. kerm:                ; [jrd] kermit routine init
  5350.     tsx            ; Get the stack pointer
  5351.     stx    kerosp        ;    and save it in case of a fatal error
  5352. kermloop:             ; kermit main loop
  5353. ;    ldx    #kmtxt\
  5354. ;    ldy    #kmtxt^
  5355. ;    jsr    dbgstk
  5356.     ldx    #prmt\        ;  Fetch the address of the prompt
  5357.     ldy    #prmt^        ;        ...
  5358.     lda    #cmini        ; Argument for comnd call
  5359.     jsr    comnd        ; Set up the parser and print the prompt
  5360.     lda    #kercmd\    ; addr of command table
  5361.     sta    cminf1        ;        ...
  5362.     lda    #kercmd^    ;        ...
  5363.     sta    cminf1+1    ;        ...
  5364.     lda    #kerhlp\    ; Store address of help text
  5365.     sta    cmhptr        ;  in help pointer
  5366.     lda    #kerhlp^    ;        ...
  5367.     sta    cmhptr+1    ;        ...
  5368.     ldy    #$00        ;  No special flags needed
  5369.     lda    #cmkey        ; Set up for keyword parse
  5370.     jsr    comnd        ; Try to parse it
  5371.      jmp    kermt2        ; Failed
  5372. ;
  5373.     stx    jtaddr        ; x,y has vector
  5374.     sty    jtaddr+1    ; set it
  5375.     jmp    (jtaddr)    ; and go there
  5376.  
  5377. ;---
  5378. ;    lda    #kermtb\    ; Get address of jump table
  5379. ;    sta    jtaddr        ;        ...
  5380. ;    lda    #kermtb^    ;        ...
  5381. ;    sta    jtaddr+1    ;        ...
  5382. ;    txa            ; Offset to AC
  5383. ;---
  5384. ; still used in a few places...
  5385. jmpind: clc            ;[DD] Jump indexed
  5386.     adc    jtaddr        ; Add offset to low byte
  5387.     sta    jtaddr        ;        ...
  5388.     bcc    jmpin1        ;        ...
  5389.     inc    jtaddr+1    ; If carry inc high byte
  5390. jmpin1: jmp    (jtaddr)    ; Jump to address
  5391. ;---
  5392.  
  5393. ;
  5394. ;kermtb: jmp    telnet        ; Connect command
  5395. ;    jmp    exit        ; Exit command
  5396. ;    jmp    help        ; Help command
  5397. ;    jmp    log        ; Log command
  5398. ;    jmp    exit        ; Quit command
  5399. ;    jmp    receve        ; Receive command
  5400. ;    jmp    send        ; Send command
  5401. ;    jmp    setcom        ; Set command
  5402. ;    jmp    show        ; Show command
  5403. ;    jmp    status        ; Status command
  5404. ;    jmp    bye        ;[EL] Shut and logout remote server command
  5405. ;    jmp    finish        ;[EL] Shut remote server
  5406. ;    jmp    getfrs        ;[EL] Get file from remote server
  5407. ;    jmp    rename        ;[40] rename files(s)
  5408. ;    jmp    dirst        ;[40] Get directory
  5409. ;    jmp    savst        ;[47] Save parameters
  5410. ;    jmp    restst        ;[47] Restore parameters
  5411. ;    jmp    erase        ; [jrd] erase something
  5412. ;---
  5413. ;
  5414. kermt2: ldx    #ermes1\    ; L.O. byte of error message
  5415.     ldy    #ermes1^    ; H.O. byte of error message
  5416. ;    jsr    prstr        ; Print the error
  5417. ;    jmp    kermit        ; Go back
  5418.     jmp    kermzz        ; [jrd] use common error vector
  5419. ;
  5420. kermt3: ldx    #ermes3\    ; L.O. byte of error
  5421.     ldy    #ermes3^    ; H.O. byte of error
  5422. ;    jsr    prstr        ; Print it
  5423. ;    jmp    kermit        ; Try again
  5424.     jmp    kermzz        ; [jrd] use common error vector
  5425. ;
  5426. kermt4: ldx    #ermes4\    ; L.O. byte of error
  5427.     ldy    #ermes4^    ; H.O. byte of error
  5428. ;    jsr    prstr        ; Print the text
  5429. ;    jmp    kermit        ; Try again
  5430.     jmp    kermzz        ; [jrd] use common error vector
  5431. ;
  5432. kermt5: ldx    #ermes6\    ; L.O. byte of error
  5433.     ldy    #ermes6^    ; H.O. byte of error
  5434. ;    jsr    prstr        ; Print error text ('keyword')
  5435. ;    jmp    kermit        ; Start at the beginning again
  5436.     jmp    kermzz        ; [jrd] use common error vector
  5437. ;
  5438. kermt6: ldx    #ermes7\    ; L.O. byte of error
  5439.     ldy    #ermes7^    ; H.O. byte of error
  5440. ;    jsr    prstr        ; Print the error message ('file spec')
  5441. ;    jmp    kermit        ;    and try again
  5442.     jmp    kermzz        ; [jrd] use common error vector
  5443. ;
  5444. kermt7: ldx    #ermes8\    ; L.O. byte of error message text
  5445.     ldy    #ermes8^    ; H.O. byte of error
  5446. ;    jsr    prstr        ; Print it ('integer')
  5447. ;    jmp    kermit        ; Try for another command line
  5448.     jmp    kermzz        ; [jrd] use common error vector
  5449. ;
  5450. ;kermt8: ldx    #ermes9\    ; L.O. byte of error
  5451. ;    ldy    #ermes9^    ; H.O. byte of error
  5452. ;    jsr    prstr        ; Print the message ('switch')
  5453. ;    jmp    kermit        ; Try for another command line
  5454. ;    jmp    kermzz        ; [jrd] use common error vector
  5455. ;
  5456. kermt9: ldx    #ermesa\    ; L.O. byte of error message
  5457.     ldy    #ermesa^    ; H.O. byte of error message
  5458. ;    jsr    prstr        ; Print the message ('')
  5459. ;    jmp    kermit        ; Try for another command line
  5460.     jmp    kermzz        ; [jrd] use common error vector
  5461. ;
  5462. kermta:    ldx    #ermesb\    ; L.O. byte of error message
  5463.     ldy    #ermesb^    ; H.O. byte of error message
  5464. ;    jsr    prstr        ; Print the message ('text')
  5465. ;    jmp    kermit        ; Go back to top of loop
  5466. ;                ; [jrd] fall into error vector
  5467. ;
  5468. kermzz:                ; common error vector
  5469.     jsr    prstr        ; print the error msg
  5470. ;    jmp    kermit        ; restart the sucker
  5471. ; fall into warmstart rtn
  5472.  
  5473. ;
  5474. ;    Nonftl - handles non-fatal DOS errors. When Kermit does its
  5475. ;    initialization it points the error vector and the basic
  5476. ;    warmstart vector here.
  5477. ;
  5478.  
  5479. nonftl:
  5480. kermit:
  5481. ;    lda    fmrcod        ; Get the DOS return code
  5482. ;    ora    #$80        ;        ...
  5483. ;    sta    errcod        ; Save that here
  5484.     ldx    kerosp        ; Get the old stack pointer back
  5485.     txs            ; Restore it
  5486.     jmp    kermloop    ; Warmstart kermit
  5487.  
  5488. ;
  5489. ;    Fatal - closes and deletes a file on which a bad error
  5490. ;    has occured (most likely a 'disk full' error). It then
  5491. ;    restores the old stack pointer and warmstarts Kermit.
  5492. ;
  5493.  
  5494. fatal:
  5495. ;    lda    fmrcod        ; Get the DOS return code
  5496. ;    ora    #$80        ; Set H.O. bit to indicate DOS error
  5497. ;    sta    errcod        ; Store the error code
  5498.     jsr    closef        ; Close the file
  5499. ;    jsr    dosdel        ; Now, delete the useless file
  5500. ;    ldx    kerosp        ; Get the old stack pointer
  5501. ;    txs            ; Restore it
  5502.     jmp    kermit        ; Warmstart kermit
  5503.  
  5504. .SBTTL    Telnet routine
  5505.  
  5506. ;
  5507. ;    This routine handles the connect command. After connecting
  5508. ;    to a host system, this routine alternates calling routines
  5509. ;    which will pass input from the port to the screen and pass
  5510. ;    output from the keyboard to the port. This kermit will
  5511. ;    ignore all characters until it sees and assigned escape
  5512. ;    character.
  5513. ;
  5514. ;        Input:  RS232 parameters
  5515. ;
  5516. ;        Output: NONE
  5517. ;
  5518. ;        Registers destroyed:    A,X,Y
  5519. ;
  5520. telnet: jsr    prcfm        ; Parse and print a confirm
  5521.     jsr    vttini        ; init tab map
  5522.     lda    #0        ; zzz debug
  5523.     sta    altcs        ; getting set spuriously?
  5524.     lda    #true        ;[48]
  5525.     sta    connec        ;[48]
  5526.     jsr    scrext        ; [jrd] make sure we're set up for
  5527.                 ;  re-entering E:
  5528.     lda    conscrt        ; [jrd] get the screen type for connect
  5529.     sta    scrtype        ; set the current screen type
  5530.     jsr    scrini        ; do any required initializations
  5531.     lda    scrtype        ; using non-atari screen?
  5532.     bne    tn1        ; if not atari screen, use stat line
  5533.     ldx    #inf01a\    ; Get address of first half of message
  5534.     ldy    #inf01a^    ;        ...
  5535.     jsr    prstr        ; Print it out
  5536.     lda    escp        ; Get the 'break connection' character
  5537.     jsr    prchr        ; Print that as a special character
  5538.     ldx    #inf01b\    ; Get address of second half of message
  5539.     ldy    #inf01b^    ;        ...
  5540.     jsr    prstr        ; Print that
  5541.     jsr    prcrlf        ;    and a crelf
  5542.     jmp    tn2
  5543. tn1:
  5544.     jsr    telslm        ; go do message in stat line
  5545. tn2:
  5546.     jsr    openrs        ;[27]
  5547.  
  5548. chrlup:    
  5549. ; [jrd]    lda    ndx        ;[39] Check keyboard queue
  5550.     lda    CH        ; FF -> no key pending
  5551.     cmp    #$FF        ; anything there?
  5552.     bne    telcnc        ;[39] Keyboard has priority over RS232
  5553. telprc:    jsr    getrs        ; Check for a port character
  5554.     bne    telcnc        ; None available, check keyboard
  5555. ;
  5556. ; if debugging enough, log received characters
  5557. ;
  5558.     lda    debug        ; get debug flag
  5559.     cmp    #verbose    ; verbose debugging?
  5560.     bne    telprnd        ; nope, go on
  5561.     jsr    teldbg
  5562. telprnd:
  5563.     lda    char        ;[31] Get the character read from port
  5564.     and    #$7F        ;[31] Shut off the high order bit
  5565.     sta    char        ;[26][31] Store the character back
  5566.     ldx    escflg        ; Was previous character an escape?
  5567.     cpx    #on        ;        ...
  5568.     bne    telp2a        ; If not, skip vt52 emulation stuff
  5569.     ldy    vtmod        ; Are we in vt52 mode?
  5570.     jsr    case
  5571.     .word    telp2a        ; glass tty. skip vt52 emulation
  5572.     .word    dovt52        ; call vt52 and jmp to ttelprr
  5573.     .word    dovt100        ; call vt100 and jmp to ttelprr
  5574.  
  5575. dovt52:    jsr    vt52        ; process the character after the esc
  5576.     jmp    telprr
  5577.  
  5578. dovt100: jsr    vt100        ; process a character in an esc sequence
  5579.     jmp    telprr
  5580.  
  5581. telp2a:
  5582.     ldy    scrtype        ; kludge.  Only xlate to atascii
  5583.     bne    telp2b        ;  if using atari E: screen
  5584. ;
  5585. ;    tax            ; do the appropriate translation
  5586. ;    lda    astoat,x
  5587. ;
  5588.     ldx    #xas2at\    ; point at table
  5589.     ldy    #xas2at^
  5590.     jsr    xlate        ; translate it
  5591. ;
  5592.     sta    char
  5593. telp2b:
  5594.     cmp    #$20        ; if less than $20, not printable character
  5595.     bcc    telp3a
  5596. ;    cmp    #$20+95        ; one of the 96 printable characters?
  5597. ;    bcs    telp3a        ; nope
  5598. ;    jsr    cout        ; print the normal character
  5599.     jsr    scrput        ; [jrd]
  5600.     clc            ; repeat forever
  5601.     jmp    chrlup
  5602. telp3a:    jsr    telpr3        ; process it
  5603. telprr:    clc            ;[39] Repeat Main terminal loop
  5604.     jmp    chrlup        ;[39]        ...
  5605.  
  5606. telcnc:    jsr    getkey        ; Get a keyboard byte
  5607. ;    beq    telcrs        ; None available, return
  5608.     bcs    telcrs        ; None available, return
  5609. ;    tax            ; run the character through the table
  5610. ;    lda    attoas,x
  5611.     sta    char        ; save it
  5612.     bpl    tlcnc5        ; if pos, process it
  5613.     ldx    #vt100fk\    ; zzz for now, vt100 wired
  5614.     ldy    #vt100fk^
  5615.     jsr    fksend        ; send the fun key
  5616.     jmp    telcrs        ; finish terminal processing
  5617. tlcnc5:    cmp    escp        ; Is it the connect-escape character?
  5618.     bne    tlcnc6        ; If so, go handle the interupt character
  5619.     ldx    scrtype        ; [jrd] only do this if in atari scr
  5620. ;
  5621. ;zzz redo this loop, it's getting gross.
  5622. ;
  5623.     bne    tlcnc6        ; [jrd] nope, we don'use it here
  5624.     jmp    intchr
  5625. tlcnc6:    lda    char
  5626.     jsr    putrs        ;[39] Output the port character
  5627.     ldx    lecho        ; Is local-echo turned on?
  5628.     cpx    #on        ;        ...
  5629.     bne    telcrs        ; If not, we are done
  5630. ;    jsr    cout        ; Output a copy to the screen
  5631.     jsr    scrput        ; [jrd]
  5632. telcrs:
  5633.     jsr    scrfls        ;[EL] Go blink the cursor
  5634.     lda    scrtype        ; in 40 mode?
  5635.     beq    telcrs1        ; nope, repeat loop
  5636.     lda    #$08        ; sanity value, H/W man page III.15
  5637.     sta    CONSOL
  5638.     lda    CONSOL        ; read console switches
  5639.     eor    #$FF        ; reverse bits
  5640.     sta    strptr        ; save for a bit
  5641.     and    #$04        ; Option key down?
  5642.     beq    telcrs0        ; nope, see about panning
  5643.     jmp    intchr        ; go do an option
  5644. telcrs0:
  5645.     lda    scrtype        ; check screen type again
  5646.     cmp    #scr40
  5647.     bne    telcrs1
  5648.     lda    strptr        ; get original bits
  5649.     and    #$03        ; mask for start, select
  5650.     bne    telpan        ; something's set, pan
  5651. telcrs1:
  5652.     clc            ;[39] Repeat main terminal loop
  5653.     jmp    chrlup        ;[39]        ...
  5654. ;
  5655. telpan:
  5656.     and    #$01        ; start?
  5657.     beq    tlpl        ; nope, must be select, pan left
  5658.     inc    panval        ; bump pan offset
  5659.     lda    panval
  5660.     cmp    #40        ; better be less
  5661.     bcs    tlpr1        ; nope, leave it at 40
  5662.     jsr    pan40        ; go do it
  5663.     jmp    chrlup        ; go do terminal loop
  5664. tlpr1:    lda    #39
  5665.     sta    panval        ; reset it to something reasonable
  5666.     jmp    chrlup
  5667. tlpl:    dec    panval        ; dec panval by 1
  5668.     bmi    tlpl1        ; oops, too far
  5669.     jsr    pan40        ; do it
  5670.     jmp    chrlup
  5671. tlpl1:    lda    #0
  5672.     sta    panval
  5673.     jmp    chrlup
  5674.  
  5675. ;    Handle special input characters
  5676.  
  5677. telpr3:    cmp    #bel        ; Is it a ^G (bell)
  5678.     bne    tlpr3a        ; No
  5679.     jsr    bell        ; Ring bell
  5680.     rts            ;[39]
  5681. tlpr3a: cmp    #cr        ; Is it a ^M (cr) ?
  5682.     bne    tlpr3b        ; No
  5683.     jsr    scrcr        ; Go do a <cr>
  5684.     rts            ;[39]
  5685. tlpr3b:    cmp    #tab        ;[26] Is it a ^I (tab) ?
  5686.     bne    tlpr3c        ;[26] No
  5687. ;    jsr    prttab        ;[26] Print to the next tab stop
  5688.     jsr    vtnxtt        ; do a real tab
  5689.     rts            ;[39]
  5690. tlpr3c:    cmp    #esc        ; Was it an 'escape'?
  5691.     bne    tlpr3d        ; No
  5692.     lda    #on        ; Set the escape flag on
  5693.     sta    escflg        ;        ...
  5694.     lda    #0        ; zero pointers for vt100 emulation
  5695.     sta    vt100st        ; state is zero
  5696.     sta    vt100pt        ; parameter pointer is zero
  5697.     rts            ; Return
  5698. tlpr3d:    cmp    #lf        ; was it a line feed
  5699.     bne    tlpr3e
  5700.     jsr    scrlf        ; perform the line feed
  5701.     rts 
  5702. tlpr3e:    cmp    #bs        ; was it a backspace?
  5703.     bne    tlpr3f
  5704.     jsr    scrl        ; move the cursor left
  5705.     rts
  5706. tlpr3f: cmp    #so        ; SO?
  5707.     bne    tlpr3g        ; nope
  5708.     lda    #1        ; yes, set alt char set (G1)
  5709.     sta    altcs        ;  this isn't really right for vt52,
  5710.     rts            ;  but who cares?
  5711. tlpr3g: cmp    #si        ; SI?
  5712.     bne    tlpr3h        ; nope
  5713.     lda    #0        ; yes, clear alt char set flg
  5714.     sta    altcs
  5715. ;    rts
  5716. tlpr3h:
  5717.     rts
  5718.  
  5719. ;
  5720. ;    Intchr - processes the character which follows the interupt
  5721. ;    character and performs functions based on what that character
  5722. ;    is.
  5723. ;
  5724.  
  5725. intchr:    lda    #conm3\        ; prompt in status line
  5726.     ldy    #conm3^
  5727.     ldx    #0
  5728.     jsr    slput        ; display it
  5729.     jsr    rdkey        ; Get the next character
  5730.     lda    char        ;[31]
  5731.     sta    kerchr        ; Save a copy of it
  5732.     and    #$5F        ; Capitalize it
  5733.     cmp    #'C        ; Does user want the connection closed?
  5734.     bne    intch0        ; If not, try next option
  5735. ;
  5736. ; talk about your basic brain damage...
  5737. ;    pla            ;[39] Fix the stack
  5738. ;    pla            ;[39]
  5739. ;
  5740.     lda    #false        ;[48]
  5741.     sta    connec        ;[48]
  5742. ; zzz    jsr    scrrst        ; reset the screen to normal characterstics
  5743.     jsr    scrext
  5744.     lda    #scrae        ; go back to atari E: screen
  5745.     sta    scrtype
  5746.     jmp    kermit        ;[39]
  5747. intch0: cmp    #'S        ; Does the user want status?
  5748.     bne    intch1        ; Nope
  5749.     jsr    stat01        ;[EL] Give it to him
  5750.     jmp    intex        ; [jrd]
  5751. intch1: cmp    #'B        ;[DD] Send break?
  5752.     bne    intc1a        ; No
  5753.     jsr    sbreak        ; Yes, go send one
  5754.     jmp    intex        ; [jrd]
  5755. intc1a: lda    kerchr        ; Fetch back the original character
  5756.     and    #$7F        ; Get rid of the H.O. bit
  5757.     cmp    #'?        ; Does user need help?
  5758.     bne    intch2        ; If not, continue
  5759.     ldx    #inthlp\    ; Get the address of the proper help string
  5760.     ldy    #inthlp^    ;        ...
  5761.     jsr    prstr        ; Print the help stuff
  5762.     jmp    intchr        ; Get another option character
  5763. intch2: cmp    escp        ; Is it another connect-escape?
  5764. ;    bne    intch4        ;[39]
  5765.     bne    intex        ;[jrd]
  5766.     jsr    putrs        ; Stuff the character at the port
  5767.     jmp    intex        ;[39]
  5768. ;intch4:
  5769. ;    cmp    #'0        ;[39]
  5770. ;    bne    intch3        ;[39] Nope, this is an error
  5771. ;    lda    #$00        ;[39]
  5772. ;    jsr    putrs        ;[39]
  5773. ;    jmp    intex        ;[39]
  5774. intch3: jsr    bell        ; Sound bell at the user
  5775. ;
  5776. intex:                ; put the status line back
  5777.     jsr    telslm        ; do appropriate msg
  5778.     jmp    telcrs        ; and go back
  5779. ;
  5780. ;    Display appropriate msg in status line
  5781. ;
  5782. conm1:    .byte    "K65: Option",0
  5783. conm2:    .byte    ",Sel,Sta",0
  5784. conm3:    .byte    "Option (C,S,B,?)",0
  5785. telslm:
  5786.     lda    #conm1\        ; [jrd] point at stat line text
  5787.     ldy    #conm1^
  5788.     ldx    #0        ; offset in stat line
  5789.     jsr    slput        ; put it
  5790.     lda    scrtype
  5791.     cmp    #scr80        ; in 80-col?
  5792.     beq    telslm1        ; yes, go ahead and connect
  5793.     lda    #conm2\        ; no, print start/sel msg
  5794.     ldy    #conm2^
  5795.     jsr    slput
  5796. telslm1:
  5797.     jsr    updstat        ; update other stat line fields
  5798.     rts
  5799.  
  5800. ;
  5801. ; debug code.  Log char received into status line
  5802. ;
  5803. teldbg:
  5804.     ldy    #0        ; idx into stat line
  5805.     ldx    #18        ; move 18 bytes
  5806. teldbg1:
  5807.     lda    statline+3,y    ; get a byte
  5808.     sta    statline,y    ; more it over
  5809.     iny            ; bump idx
  5810.     dex            ; dec count
  5811.     bne    teldbg1        ; and go around
  5812.     lda    char        ; get the char
  5813.     lsr    a        ; shift it down
  5814.     lsr    a
  5815.     lsr    a
  5816.     lsr    a
  5817.     jsr    ny2hx        ; get a hex char
  5818.     sec
  5819.     sbc    #$20        ; offset for display
  5820.     sta    statline,y    ; shove it in
  5821.     iny
  5822.     lda    char        ; get char again
  5823.     and    #$0F        ; mask
  5824.     jsr    ny2hx
  5825.     sec
  5826.     sbc    #$20        ; offset for display
  5827.     sta    statline,y    ; this one into stat line
  5828.     iny
  5829.     lda    #0        ; display a space
  5830.     sta    statline,y
  5831.     rts
  5832.  
  5833. ;
  5834. ;    Vt52 - will carry out the equivalent of most of the vt52 functions
  5835. ;    available.
  5836. ;
  5837.  
  5838. vt52:    lda    #off        ; First, turn off the escape flag
  5839.     sta    escflg        ;        ...
  5840.     lda    char        ;[26] Get the character to check
  5841.     and    #$7F        ; Turn off the H.O. bit
  5842.     cmp    #'A        ; Is it greater than 'A' and less than
  5843.     bmi    vt52y        ;[26]    or equal to 'z'????
  5844.     cmp    #'z        ;[26]        ...
  5845.     bmi    vt52z        ;[26] If it isn't, ignore it
  5846. vt52y:    jmp    vtig        ;[26]
  5847. vt52z:
  5848. ; all obsolete?
  5849. ;    sec            ;[26] Get the cursor position
  5850. ;    jsr    ploth        ;[26] in X,Y
  5851. ;;    sty    hch        ;[39]
  5852. ;    stx    hch        ;[39]
  5853. ;;    stx    hcv        ;[39]
  5854. ;    sty    hcv        ;[39]
  5855.     cmp    #'A        ; It is, is it an 'A'?
  5856.     bne    vt52a        ; No, try next character
  5857.     jsr    scru        ; Go up one line
  5858.     rts            ; Return
  5859. vt52a:  cmp    #'B        ; Is it a 'B'?
  5860.     bne    vt52b        ; Next char
  5861.     jsr    scrd        ; Yes, go down one line
  5862.     rts            ;    and go back
  5863. vt52b:  cmp    #'C        ; 'C'?
  5864.     bne    vt52c        ; Nope
  5865.     jsr    scrr        ; Yes, go forward one space
  5866.     rts            ;    and return
  5867. vt52c:  cmp    #'D        ; 'D'?
  5868.     bne    vt52d        ; No
  5869.     jsr    scrl        ; Yes, do a back-space
  5870.     rts            ; Return
  5871. vt52d:  cmp    #'H        ; 'H'?
  5872.     bne    vt52e        ; No, try next character
  5873.     ldx    #0
  5874.     ldy    #0
  5875.     jsr    scrplt        ; Home cursor (no clear screen)
  5876.     rts            ;    then return
  5877. vt52e:  cmp    #'I        ; 'I'?
  5878.     bne    vt52f        ; Nope
  5879.     jsr    scrrlf        ;[39] Do a reverse line feed
  5880.     rts            ;  and return
  5881. vt52f:  cmp    #'J        ; 'J'?
  5882.     bne    vt52g        ; No
  5883.     jsr    scred0        ; Clear from where we are to end-of-page
  5884.     rts            ;    then return
  5885. vt52g:  cmp    #'K        ; 'K'?
  5886.     bne    vt52h        ; Try last option
  5887.     jsr    screl0        ; Clear to end-of-line
  5888.     rts            ; Return
  5889. vt52h:  cmp    #'Y        ; 'Y'
  5890.     bne    vt52i        ;[19]
  5891.     jsr    vtdca        ; Do direct cursor addressing
  5892.     rts            ;    then return
  5893. vt52i:    cmp    #'o        ;[19] 'o'
  5894.     bne    vt52j        ;[19]
  5895.     lda    #1
  5896.     sta    reverse        ; turn reverse on
  5897.     rts            ;[19] Return
  5898. vt52j:    cmp    #'n        ;[19] 'n'
  5899.     bne    vtig        ;[19] Must be an unimplemented fn, do vtig
  5900.     lda    #0
  5901.     sta    reverse        ; turn reverse off
  5902.     rts            ;[19]
  5903. vtig:    pha            ; Save a copy
  5904.     lda    #esc        ; Get an escape
  5905.     jsr    prchr        ; Print the special character
  5906.     pla            ; Fetch the other character back
  5907.     cmp    #esc        ; Is it a second escape?
  5908.     bne    vtig1        ; Nope, print it
  5909.     lda    #on        ; Set escflg on again for next time around
  5910.     sta    escflg        ;        ...
  5911.     rts            ;    and return
  5912. vtig1:  jsr    prchr        ; Print the character
  5913.     rts            ;    and return
  5914.  
  5915. vtdca:    jsr    getrs        ; Check for a character from the port
  5916.     bne    vtdca        ; Try again
  5917.     lda    char        ;[31]
  5918.     and    #$7F        ; Make sure H.O. bit is off
  5919.     sec            ; Subtract hex 30 (make it num from 0 to 23)
  5920.     sbc    #$20        ;        ...
  5921. vtdca2: pha            ; save it
  5922. vtdca3:    jsr    getrs        ; Check port for character
  5923.     bne    vtdca3        ;    go back and try again
  5924.     lda    char        ;[31]
  5925.     and    #$7F        ; Make sure h.o. bit is off
  5926.     sec            ; Subtract hex 20 (make it num from 0 to 23)
  5927.     sbc    #$20        ;        ...
  5928. vtdca5: tax            ; this is the horizontal position
  5929.     pla            ; remember the vertical position
  5930.     tay
  5931.     jsr    scrplt        ; move the cursor here
  5932.     jsr    scrpan        ; pan if needed
  5933.     rts            ;    and return
  5934.  
  5935.  
  5936. .SBTTL    VT100 Emulation Routines
  5937.  
  5938. ;
  5939. ;    vt100 - parse a character in a vt100 command sequence
  5940. ;
  5941. ;    Input - A character in the A-reg
  5942. ;
  5943. ;    This routine processes characters after an esc in VT100 mode.
  5944. ;    It parses the command and calls a routine to perform the requested
  5945. ;    function when the last character in the sequence has been received.
  5946. ;
  5947.  
  5948. vt100:    ldx    vt100st        ; state of the command parser
  5949. vt100d:    ldy    vt100ta,x    ; check the parser table
  5950.     beq    vt100b        ; esape sequence is illegal
  5951.     bpl    vt100a        ; is parameter expected?
  5952.     cmp    #1+'9        ; yes.  Was a digit received?
  5953.     bcs    vt100a        ; no, it is not a digit
  5954.     cmp    #'0
  5955.     bcc    vt100a        ; not a digit (carry set for next line)
  5956.     sbc    #'0        ; convert the digit to a value (0..9)
  5957.     pha            ; save it
  5958.     ldy    vt100pt        ; pointer into parameter list
  5959.     lda    freemem,y        ; get the current value
  5960.     asl    a        ; multiplied by 2
  5961.     pha            ; save that too
  5962.     asl    a        ; multiplied by 4
  5963.     asl    a        ; multiplied by 8
  5964.     sta    freemem,y
  5965.     pla
  5966.     clc
  5967.     adc    freemem,y    ; multiplied by 10
  5968.     sta    freemem,y
  5969.     pla
  5970.     clc
  5971.     adc    freemem,y    ; add in the digit
  5972.     sta    freemem,y    ; save the new value of the parameter
  5973.     rts            ; all done (for now. escflg still set)
  5974.  
  5975. vt100a:    cmp    vt100ta,x    ; found character in table?
  5976.     beq    vt100c        ; yes. go change state
  5977.     inx            ; skip to the next entry
  5978.     inx
  5979.     inx
  5980.     jmp    vt100d        ; check this character
  5981.  
  5982. vt100c:    lda    vt100ta+2,x    ; high order byte of routine to call
  5983.     beq    vt100e        ; $00 = state change
  5984.     sta    dest+1
  5985.     lda    vt100ta+1,x    ; low order byte of routine to call
  5986.     sta    dest
  5987.     lda    #0
  5988.     sta    escflg        ; this command is complete
  5989.     jmp    (dest)        ; perform requested function
  5990.  
  5991. vt100e:    ldy    vt100ta+1,x    ; state to change to
  5992.     sty    vt100st        ; change to it
  5993.     lda    vt100ta,y    ; is a parameter expected?
  5994.     bpl    vt100f        ; no.
  5995.     inc    vt100pt        ; make pointer point to next parameter
  5996.     ldy    vt100pt        ; and zero the parameter
  5997.     lda    #0
  5998.     sta    freemem,y
  5999. vt100f:    rts            ; all done (for now. escflg still set)
  6000.  
  6001. vt100b:    lda    #0        ; an error has occured.  abort processing
  6002.     sta    escflg
  6003.     rts            ; all done
  6004.  
  6005. ;
  6006. ;    vt100b1 - process the <esc> '['  integer 'J' vt100 sequence
  6007. ;
  6008. ;    This routine calls scred0, scred1, or scred2 depending on the
  6009. ;    value of the integer.
  6010. ;
  6011.  
  6012. vt100b1: ldy    freemem+1    ; what is the integer
  6013.     cpy    #3        ; check for strange vt100 sequences
  6014.     bcs    vt100er        ; this is a strange sequence
  6015.     jsr    case        ; call the proper routine
  6016.     .word    scred0        ; call scred0 if the integer is 0
  6017.     .word    scred1        ; call scred1 if the integer is 1
  6018.     .word    scred2        ; call scred2 if the integer is 2
  6019.  
  6020. ;
  6021. ;    vt100c1 - process the <esc> '[' integer 'K'
  6022. ;
  6023. ;    This routine calls screl0, screl1, or screl2 depending on the
  6024. ;    value of the integer.
  6025.  
  6026. vt100c1: ldy    freemem+1    ; what is the integer
  6027.     cpy    #3        ; check for strange vt100 sequences
  6028.     bcs    vt100er        ; this is a strange sequence
  6029.     jsr    case        ; call the proper routine
  6030.     .word    screl0        ; call screl0 if the integer is 0
  6031.     .word    screl1        ; call screl1 if the integer is 1
  6032.     .word    screl2        ; call screl2 if the integer is 2
  6033.  
  6034. ;
  6035. ;    vt100d1 - process the <esc> '[' integer ';' integer 'f' and
  6036. ;                 <esc> '[' integer ';' integer 'H' vt100 commands
  6037. ;
  6038. ;    This routine calls scrplt to put the cursor at the position indicated
  6039. ;    by the two integers.
  6040.  
  6041. vt100d1: ldx    #0        ; get the first integer
  6042.     ldy    #1        ; default value is 1
  6043.     jsr    vt100pa
  6044.     tay
  6045.     dey            ; solve the off-by-one problem
  6046.     cpy    #24        ; check it for reasonability
  6047.     bcc    vt100d2
  6048.     tay            ; if unreasonable, move cursor to bottom line
  6049. vt100d2: sty    dest        ; save y position
  6050.     ldx    #1        ; get the second integer
  6051.     ldy    #1        ; default value is 1
  6052.     jsr    vt100pa
  6053.     tax
  6054.     dex            ; solve the off-by-one problem
  6055.     jsr    rghchk        ; check it for reasconablilty
  6056.     bcc    vt100d3
  6057.     tax            ; if unreasonable, move cursor to far right
  6058. vt100d3: ldy    dest        ; get y position
  6059.     jsr    scrplt        ; finally move the cursor
  6060.     jsr    scrpan        ; pan if necessary
  6061.     rts            ; all done
  6062.  
  6063. ;
  6064. ;    vt100e1 - process the <esc> integer ';' integer 'r' sequence
  6065. ;
  6066. ;    This routine sets the top and bottom of the scrolling area.
  6067. ;
  6068.  
  6069. vt100e1: ldx    #0        ; get the first parameter
  6070.     ldy    #1        ; default value is one
  6071.     jsr    vt100pa
  6072.     tay
  6073.     dey            ; solve the off-by-one problem
  6074.     jsr    botchk        ; check it for reasonability
  6075.     bcs    vt100e2
  6076.     sty    dest        ; save top of screen
  6077.     tay            ; get default value for bottom (from botchk)
  6078.     iny            ; solve the off-by-one problem
  6079.     ldx    #1        ; get the second parameter
  6080.     jsr    vt100pa
  6081.     tay
  6082.     dey            ; solve the off-by-one problem
  6083.     jsr    botchk        ; check it for reasonablilty
  6084.     bcs    vt100e2
  6085.     cpy    dest        ; save it
  6086.     bcc    vt100e2        ; unreasonable
  6087.     sty    bot        ; set the bottom margin
  6088.     ldy    dest        ; set the tom margin
  6089.     sty    top
  6090. ;
  6091. ; zzz deal with origin mode here
  6092. ;
  6093.     ldy    #0        ; for now assume normal origin
  6094.     ldx    #0        ; move cursor to home position
  6095.     jsr    scrplt
  6096.  
  6097. vt100e2: rts
  6098.  
  6099. vt100er: jsr    beeplo
  6100.     rts
  6101.     
  6102. ;
  6103. ;    vt100f1 - process the <esc> '[' integer 'A' sequence
  6104. ;
  6105. ;    This routine moves the cursor up <integer> lines
  6106. ;
  6107.  
  6108. vt100f1: ldx    #0        ; get the parameter
  6109.     ldy    #1        ; default value is one
  6110.     jsr    vt100pa
  6111.     sec            ; cutsy way to subtract it form cursor pos
  6112.     eor    #$FF
  6113.     adc    ROWCRS
  6114.     tay
  6115.     bcc    vt100f3        ; gone past top of screen
  6116.     cpy    top        ; outside scrolling area
  6117.     bcs    vt100f2        ; no
  6118. vt100f3: ldy    top        ; move cursor to top
  6119. vt100f2: ldx    COLCRS
  6120.     jsr    scrplt        ; plot the cursor here
  6121.     rts
  6122.  
  6123. ;
  6124. ;    vt100g1 - process the <esc> '[' integer 'B' sequence
  6125. ;
  6126. ;    This routine moves the cursor down <integer> lines
  6127. ;
  6128.  
  6129. vt100g1: ldx    #0        ; get the parameter
  6130.     ldy    #1
  6131.     jsr    vt100pa
  6132.     clc            ; add the parameter to ROWCRS
  6133.     adc    ROWCRS
  6134.     tay
  6135.     cpy    bot        ; see if still in scrolling area
  6136.     beq    vt100g2
  6137.     bcc    vt100g2
  6138.     ldy    bot        ; nope. move the cursor to the bottom
  6139. vt100g2: ldx    COLCRS
  6140.     jsr    scrplt        ; plot the cursor here
  6141.     rts            ; all done
  6142.  
  6143. ;
  6144. ;    vt100h1 - process the <esc> '[' integer 'C' sequence
  6145. ;
  6146. ;    This routine moves the cursor right <integer> characters
  6147. ;
  6148.  
  6149. vt100h1: ldx    #0        ; get the parameter
  6150.     ldy    #1        ; default value in one
  6151.     jsr    vt100pa
  6152.     clc            ; add it into the current cursor position
  6153.     adc    COLCRS
  6154.     tax
  6155.     jsr    rghchk        ; check it for reasonability
  6156.     bcc    vt100h2        ; it is reasonable
  6157.     tax            ; if unreasonable, move cursor to far right
  6158. vt100h2: ldy    ROWCRS        ; plot the cursor here
  6159.     jsr    scrplt
  6160.     rts
  6161.  
  6162. ;
  6163. ;    vt100i1 - process the <esc>  '[' integer 'D' sequence
  6164. ;
  6165. ;    This routine moves the cursor left <integer> characters
  6166. ;
  6167.  
  6168. vt100i1: ldx    #0        ; get the parameter
  6169.     ldy    #1        ; default value is one
  6170.     jsr    vt100pa
  6171.     sec            ; cutsy way to subtract from COLCRS
  6172.     eor    #$FF
  6173.     adc    COLCRS
  6174.     bcs    vt100i2        ; check if gone past left margin
  6175.     lda    #0        ; if so, move to far left
  6176. vt100i2: tax
  6177.     ldy    ROWCRS        ; plot the cursor here
  6178.     jsr    scrplt
  6179.     rts
  6180.  
  6181. ;
  6182. ;    vt100j1 - process the <esc> '[' [  integer ';' ...] 'm' sequence
  6183. ;
  6184. ;    This routine sets the graphic rendition (reverse, alternate colors,
  6185. ;    underline and flashing) parameters.  Note that it may be passed
  6186. ;    0 or more parameters
  6187. ;
  6188.  
  6189. vt100j1: ldx    #0        ; start with the first parameter
  6190. vt100j5: ldy    #0        ; default value is zero
  6191.     jsr    vt100pa
  6192.     beq    vt100j3        ; if zero, clear everything
  6193.     tay
  6194.     cpy    #8
  6195.     bcs    vt100j4        ; unreasonable parameter!
  6196.     lda    #1        ; set the proper parameter
  6197.     sta    vt100gr-1,y
  6198.     bne    vt100j4        ; always taken
  6199. vt100j3: jsr    vt100j2        ; clear everything
  6200. vt100j4: inx            ; get the next parameter
  6201.     cpx    vt100pt        ; all done?
  6202.     bcc    vt100j5        ; nope.  Do some more
  6203.     rts            ; all done.
  6204.  
  6205. vt100j2: lda    #0        ; clear everything
  6206.     sta    alternt        ; alternate color (highlighting)
  6207.     sta    flash        ; flashing off
  6208.     sta    underln        ; dont underline
  6209.     sta    reverse        ; dont reverse
  6210.     rts            ; everything cleared.
  6211.  
  6212. ;
  6213. ;    vt100k1 - process the <esc>  '[' integer 'D' sequence
  6214. ;
  6215. ;    This routine deletes <integer> lines
  6216. ;
  6217.  
  6218. vt100k1: ldx    #0        ; get the parameter
  6219.     ldy    #1        ; default value is one
  6220.     jsr    vt100pa
  6221.     sta    tmpptr        ; [jrd] this should be safe...
  6222. vt100k2:
  6223.     dec    tmpptr        ; dec count
  6224.     bmi    vt100k3        ; if gone minus, stop
  6225.     jsr    scrdl        ; delete one
  6226.     jmp    vt100k2
  6227. vt100k3:            ; done
  6228.     rts
  6229.  
  6230. ;
  6231. ;    vt100l1 - process the <esc>  '[' integer 'D' sequence
  6232. ;
  6233. ;    This routine inserts <integer> lines
  6234. ;
  6235.  
  6236. vt100l1: ldx    #0        ; get the parameter
  6237.     ldy    #1        ; default value is one
  6238.     jsr    vt100pa
  6239.     sta    tmpptr        ; [jrd] this should be safe...
  6240. vt100l2:
  6241.     dec    tmpptr        ; dec count
  6242.     bmi    vt100l3        ; if gone minus, stop
  6243.     jsr    scril        ; insert one
  6244.     jmp    vt100l2
  6245. vt100l3:            ; done
  6246.     rts
  6247.  
  6248.  
  6249. ;
  6250. ;    botchk - check to see if y-reg is below bottom of screen
  6251. ;
  6252. ;    Output:    Carry flag set if past bottom of screen
  6253. ;        A-reg holds line number of screen bottom
  6254. ;
  6255. ;    This routine checks to see if the y-reg is greater than the bottom
  6256. ;    of the screen.
  6257.  
  6258. botchk:    lda    #23
  6259.     cpy    #24
  6260.     rts
  6261.  
  6262. ;
  6263. ;    rghchk - check to see if x-reg is past right margin of screen
  6264. ;
  6265. ;    Input:    scrtype
  6266. ;
  6267. ;    Output:    Carry flag set if past right margin of screen
  6268. ;        A-reg holds right margin of screen
  6269. ;
  6270. ;    This routine checks to see if the x-reg is greater than the bottom
  6271. ;    of the screen.
  6272.  
  6273. rghchk:    lda    scrtype        ; check to see if in 40-column mode
  6274.     beq    rghchk1        ; branch if it is
  6275.     lda    #79
  6276.     cpx    #80
  6277.     rts
  6278. rghchk1: lda    #39        ; only 40 columns available
  6279.     cpx    #40
  6280.     rts
  6281.  
  6282. ;
  6283. ;    vt100pa - get a parameter for vt100 emulation
  6284. ;
  6285. ;    Input:    X-reg - which parameter is desired (0..n)
  6286. ;        Y-reg - default value of this parameter
  6287. ;
  6288. ;    Output:    A-reg - value of this parameter
  6289. ;
  6290. ;    This routine returns the value of the requested parameter.  If
  6291. ;    the parameter is zero or undefined, it returns the default value.
  6292. ;
  6293.  
  6294. vt100pa: cpx    vt100pt        ; was the necessary number of params given
  6295.     bcs    vt100pb        ; no, use the default
  6296.     lda    freemem+1,x    ; get this parameter
  6297.     beq    vt100pb        ; if zero, use the default
  6298.     rts
  6299. vt100pb: tya            ; return the default
  6300.     rts
  6301.  
  6302. ;
  6303. ;     things to set char set slots in response to SCS esc sequences
  6304. ;
  6305. scsg0us:
  6306.     lda    #csascii    ; use char set ascii 
  6307.     sta    csg0        ;  for G0
  6308.     rts
  6309. scsg0gr:
  6310.     lda    #csgraf        ; use graphics set
  6311.     sta    csg0        ;  got G0
  6312.     rts
  6313. scsg1us:
  6314.     lda    #csascii    ; use ascii
  6315.     sta    csg1        ;  for G1
  6316.     rts
  6317. scsg1gr:
  6318.     lda    #csgraf        ; use graphics
  6319.     sta    csg1        ;  for G1
  6320.     rts
  6321.  
  6322. ;
  6323. ; set tab at current column
  6324. ;
  6325. vttset:
  6326.     ldx    COLCRS        ; get column
  6327.     lda    #1
  6328.     sta    tabstop,x    ; zap it
  6329.     rts
  6330.  
  6331. ;
  6332. ; clear tab at current col.
  6333. ;
  6334. vttclr:
  6335.     ldx    #0        ; parm 0 please
  6336.     ldy    #0        ; default 0
  6337.     jsr    vt100pa        ; get a parameter
  6338.     cmp    #3        ; clear all?
  6339.     beq    vttclra        ; yes, clear all
  6340.     ldx    COLCRS        ; get column
  6341.     lda    #0
  6342.     sta    tabstop,x    ; zap it
  6343.     rts
  6344. vttclra:
  6345.     ldx    #79
  6346.     lda    #0
  6347. vttcn:    sta    tabstop,x
  6348.     dex
  6349.     bpl    vttcn
  6350.     rts
  6351.  
  6352. vttini:
  6353.     jsr    vttclra        ; first clear all
  6354.     lda    #8
  6355. vtti1:
  6356.     tax
  6357.     lda    #1
  6358.     sta    tabstop,x
  6359.     txa
  6360.     clc
  6361.     adc    #8
  6362.     cmp    #80
  6363.     bcc    vtti1
  6364.     rts    
  6365.  
  6366. ;
  6367. ; next tab stop
  6368. ;
  6369. vtnxtt:
  6370.     ldx    COLCRS
  6371. vtnt1:
  6372.     inx
  6373.     cpx    #80
  6374.     bcs    vtnt8
  6375.     lda    tabstop,x
  6376.     beq    vtnt1
  6377.     bne    vtnt9
  6378. vtnt8:    ldx    #79
  6379. vtnt9:    ldy    ROWCRS
  6380.     jsr    scrplt
  6381.     rts
  6382.  
  6383. ;
  6384. ;    vt100ta - parser table for vt100 commands
  6385. ;
  6386. ;    the first byte of each entry is a character to expect.  If the
  6387. ;    character to expect is negative, it means to parse a parameter
  6388. ;    and remain in the current state.  If it is zero, that is the end
  6389. ;    of the entry.  If it is the character received,    the next word is looked
  6390. ;    at.  If it is less than $100, the parser changes into that state.  If
  6391. ;    it is greater or equal to $100, the routine at that address is called.
  6392. ;
  6393.  
  6394. vt100ta: .byte    '[
  6395.     .word    vt100a1-vt100ta
  6396.     .byte    'M        ; <esc> 'M'
  6397.     .word    scrrlf        ;        is reverse index
  6398.     .byte    'E        ; <esc> 'E'
  6399.     .word    scrlf        ;        is next line
  6400.     .byte    'D        ; <esc> 'D'
  6401.     .word    scrlf        ;        is index
  6402.     .byte    '7        ; <esc> '7'
  6403.     .word    scrsav        ;        means save cursor position
  6404.     .byte    '8        ; <esc> '8'
  6405.     .word    scrlod        ;        means load cursor position
  6406.     .byte    'H        ; <esc> 'H'
  6407.     .word    vttset        ;        set tab stop 
  6408. ;
  6409. ; added by jrd for SCS support. 
  6410. ;
  6411.     .byte    '(        ; <esc> '('
  6412.     .word    vt100a4-vt100ta    ; set a4 state, expecting g0 spec
  6413.     .byte    ')        ; <esc> ')'
  6414.     .word    vt100a5-vt100ta    ; set a5 state, expecting g1 spec
  6415. ;
  6416.     .byte    $00
  6417.  
  6418. vt100a1: .byte    $FF
  6419.     .word    0
  6420.     .byte    'J        ; <esc> '[' integer 'J'
  6421.     .word    vt100b1
  6422.     .byte    'K        ; <esc> '[' integer 'K'
  6423.     .word    vt100c1
  6424.     .byte    'A        ; <esc> '[' integer 'A'
  6425.     .word    vt100f1
  6426.     .byte    'B        ; <esc> '[' integer 'B'
  6427.     .word    vt100g1
  6428.     .byte    'C        ; <esc> '[' integer 'C'
  6429.     .word    vt100h1
  6430.     .byte    'D        ; <esc> '[' integer 'D'
  6431.     .word    vt100i1
  6432.     .byte    'm        ; <esc> '[' [integer ';']... 'm'
  6433.     .word    vt100j1
  6434. ;
  6435. ; added by jrd, for insert/delete line support
  6436. ;
  6437.     .byte    'M
  6438.     .word    vt100k1        ; delete line(s)
  6439.     .byte    'L
  6440.     .word    vt100l1        ; insert line(s)
  6441. ;
  6442.     .byte    ';
  6443.     .word    vt100a2-vt100ta
  6444.     .byte    'f        ; <esc> '[' 'f'
  6445.     .word    vt100d1
  6446.     .byte    'H        ; <esc> '[' 'H'
  6447.     .word    vt100d1
  6448.     .byte    'r        ; <esc> '[' 'r'
  6449.     .word    vt100e1
  6450.     .byte    '?        ; <esc> '[' '?'
  6451.     .word    vt100a3-vt100ta
  6452.     .byte    'g        ; <esc> '[' g
  6453.     .word    vttclr        ; clear tab stop
  6454.     .byte    $00
  6455.  
  6456. vt100a2: .byte    $FF
  6457.     .word    0
  6458.     .byte    'H
  6459.     .word    vt100d1        ; <esc> integer ';' integer 'H'
  6460.     .byte    'f
  6461.     .word    vt100d1        ; <esc> integer ';' integer 'f'
  6462.     .byte    'r
  6463.     .word    vt100e1        ; <esc> integer ';' integer 'r'
  6464.     .byte    'm
  6465.     .word    vt100j1        ; <esc> integer ';' integer... 'm'
  6466. ;
  6467. ; added by jrd.  is this necessary?
  6468. ;
  6469.     .byte    ';
  6470.     .word    vt100a2-vt100ta    ; ; means stay in this state
  6471. ;
  6472.     .byte    0
  6473.  
  6474. vt100a3: .byte    $FF
  6475.     .word    0
  6476.     .byte    'h        ; <esc> '[' '?' integer 'h'
  6477.     .word    anyrts        ; ignored (for now)
  6478.     .byte    'l        ; <esc> '[' '?' integer 'l'
  6479.     .word    anyrts        ; ignored (for now)
  6480.     .byte    ';
  6481.     .word    vt100a3-vt100ta
  6482.     .byte    0
  6483.  
  6484. ;
  6485. ; SCS support. Note that we only support the USASCII and Graphics sets,
  6486. ; others are ignored.
  6487. ;
  6488. vt100a4:             ; no parameters here
  6489.     .byte    'B        ; <esc> ( B
  6490.     .word    scsg0us        ; set us ascii as g0
  6491.     .byte    '0        ; <esc> ( 0
  6492.     .word    scsg0gr        ; set graphics as g0
  6493.     .byte    'A        ; <esc> ( A
  6494.     .word    scsg0us        ; should really be uk
  6495.     .byte    0
  6496.  
  6497. vt100a5: 
  6498.     .byte    'B        ; <esc> ) B
  6499.     .word    scsg1us
  6500.     .byte    '0
  6501.     .word    scsg1gr
  6502.     .byte    'A        ; <esc> ) A
  6503.     .word    scsg1us        ; should really be uk
  6504.     .byte    0
  6505.  
  6506.     .byte    *-vt100ta    ; abort assembly if table length > $100
  6507. .SBTTL    Exit routine
  6508.  
  6509. ;
  6510. ;    This routine exits properly from Kermit-65 and reenters
  6511. ;    Atari DOS
  6512. ;
  6513. ;        Input:  NONE
  6514. ;
  6515. ;        Output: NONE
  6516. ;
  6517. ;        Registers destroyed:    A,X
  6518. ;
  6519.  
  6520. ;exit:    lda    #cmcfm        ; Try to get a confirm
  6521. ;    jsr    comnd        ; Do it
  6522. ;     jmp    kermt3        ; Give '?not confirmed' message
  6523. ;
  6524. exit1:    jsr    restor        ;[36] Restore everything to its' default state
  6525. ;    lda    r6510        ;[17] Prepare to terminate
  6526. ;    ora    #1        ;[17]  by paging BASIC ROM in
  6527. ;    sta    r6510        ;[17]         ...
  6528. ;exit2:  jmp    (dos)        ; Now restart BASIC
  6529.     ldx    keresp        ; [jrd] Not here you don't.
  6530.     txs            ;    Get our stack back
  6531.     lda    kerret+1    ;    make sure ret addr is ok
  6532.     pha            ;    and...
  6533.     lda    kerret
  6534.     pha
  6535.     rts            ;   return
  6536.  
  6537. restor:
  6538. ; [jrd]    jsr    clall        ;[19][36] Close all channels
  6539.     jsr    scrext        ; restore screen hardward to its initial state
  6540.     rts            ;[36] Return
  6541.  
  6542. .SBTTL    Help routine
  6543.  
  6544. ;
  6545. ;    This routine prints help from the current help text
  6546. ;    area.
  6547. ;
  6548. ;        Input:  Cmhptr  - Pointer to the desired text to be printed
  6549. ;
  6550. ;        Output: ASCIZ string at Cmhptr is printed on screen
  6551. ;
  6552. ;        Registers destroyed:    A,X,Y
  6553. ;
  6554.  
  6555. help:    lda    #cmcfm        ; Try to get a confirm
  6556.     jsr    comnd        ; Go get it
  6557.      jmp    kermt3        ; Didn't find one? Give 'not confirmed' message
  6558. help2:  ldx    cmhptr        ; L.O. byte of current help text address
  6559.     ldy    cmhptr+1    ; H.O. byte of address
  6560. ;    jsr    prstr        ; Print it
  6561. ;    jmp    kermit        ; Return to main routine
  6562.     jmp    kermzz        ; [jrd] use common print vector
  6563. ;
  6564.  
  6565. .SBTTL    Log routine
  6566.  
  6567. ;
  6568. ;    This routine logs a session to a disk file.
  6569. ;
  6570. ;        Input:  NONE
  6571. ;
  6572. ;        Output: NONE
  6573. ;
  6574. ;        Registers destroyed:    NONE
  6575. ;
  6576.  
  6577. log:    jmp    kermit
  6578.  
  6579. .SBTTL    Bye routine
  6580.  
  6581. ;
  6582. ;    This routine terminates the remote server, logs out and terminates
  6583. ;    the local Kermit.
  6584. ;
  6585.  
  6586. bye:    jsr    prcfm        ; Go parse and print the confirm
  6587.     jsr    logo        ; Tell other Kermit to log out
  6588.      jmp    kermit        ; Don't exit if there was an error
  6589. quit:
  6590. ;    jmp    exit1        ; Leave
  6591.     rts            ; [jrd] let the main routine exit for us
  6592.  
  6593. ;
  6594. ;    Logo - This routine does the actual work to send the logout
  6595. ;    packet to the remote server
  6596. ;
  6597.  
  6598. logo:    jsr    openrs        ;[27] Reset the RS-232 channel
  6599.     lda    #0        ; Zero the number of tries
  6600.     sta    numtry        ;        ...
  6601.     sta    tpak        ;    and the total packet number
  6602.     sta    tpak+1        ;        ...
  6603.     lda    #pdbuf\        ;[29] Get the address of the packet buffer
  6604.     sta    kerbf1        ;[29]   and save it for Spak
  6605.     lda    #pdbuf^        ;[29]        ...
  6606.     sta    kerbf1+1    ;[29]        ...
  6607. logo1:    lda    numtry        ; Fetch the number of tries
  6608.     cmp    maxtry        ; Have we exceeded Maxtry?
  6609.     bmi    logo3        ; Not yet, go send the packet
  6610. logo2:    ldx    #ermesc\    ; Yes, give an error message
  6611.     ldy    #ermesc^    ;        ...
  6612.     jsr    prstr        ;        ...
  6613.     jsr    prcrlf        ;        ...
  6614.     rts            ;    and return
  6615. logo3:    inc    numtry        ; Increment the number of tries for packet
  6616.     lda    #0        ; Make it packet number 0
  6617.     sta    pnum        ;        ...
  6618.     lda    #1        ; Data length is only 1
  6619.     sta    pdlen        ;        ...
  6620.     lda    #'L        ; The 'Logout' command
  6621.     sta    pdbuf        ; Put that in first character of buffer
  6622.     lda    #'G        ; Generic command packet type
  6623.     sta    ptype        ;        ...
  6624.     jsr    flshin        ;[25] Flush the RS232 buffer
  6625.     jsr    spak        ; Send the packet
  6626.     jsr    rpak        ; Try to fetch an ACK
  6627.     cmp    #true        ; Did we receive successfully?
  6628.     bne    logo1        ; No, try to send the packet again
  6629.     lda    ptype        ; Get the type
  6630.     cmp    #'Y        ; An ACK?
  6631.     bne    logoce        ; No, go check for error
  6632.     jmp    rskp        ; Yes, skip return
  6633. logoce:    cmp    #'E        ; Error packet?
  6634.     bne    logo1        ; Nope, resend packet
  6635.     jsr    prcerp        ; Go display the error
  6636.     rts            ;    and return
  6637.  
  6638. .SBTTL    Finish routine
  6639.  
  6640. ;
  6641. ;    This routine terminates the remote server but does not log
  6642. ;    it out. It also keeps the local Kermit running.
  6643. ;
  6644.  
  6645. finish:    jsr    prcfm        ; Go parse and print the confirm
  6646.     jsr    openrs        ;[27] Reset the RS232 channel
  6647.     lda    #0        ; Zero the number of tries
  6648.     sta    numtry        ;        ...
  6649.     sta    tpak        ;    and the total packet number
  6650.     sta    tpak+1        ;        ...
  6651.     lda    #pdbuf\        ;[29] Get the address of the packet buffer
  6652.     sta    kerbf1        ;[29]   and save it for Spak
  6653.     lda    #pdbuf^        ;[29]        ...
  6654.     sta    kerbf1+1    ;[29]        ...
  6655. finsh1:    lda    numtry        ; Fetch the number of tries
  6656.     cmp    maxtry        ; Have we exceeded Maxtry?
  6657.     bmi    finsh3        ; Not yet, go send the packet
  6658. finsh2:    ldx    #ermesd\    ; Yes, give an error message
  6659.     ldy    #ermesd^    ;        ...
  6660.     jsr    prstr        ;        ...
  6661.     jsr    prcrlf        ;        ...
  6662.     jmp    kermit        ;    and go back for more commands
  6663. finsh3:    inc    numtry        ; Increment the number of tries for packet
  6664.     lda    #0        ; Make it packet number 0
  6665.     sta    pnum        ;        ...
  6666.     lda    #1        ; Data length is only 1
  6667.     sta    pdlen        ;        ...
  6668.     lda    #'F        ; The 'Finish' command
  6669.     sta    pdbuf        ; Put that in first character of buffer
  6670.     lda    #'G        ; Generic command packet type
  6671.     sta    ptype        ;        ...
  6672.     jsr    flshin        ;[25] Flush the RS232 buffer
  6673.     jsr    spak        ; Send the packet
  6674.     jsr    rpak        ; Try to fetch an ACK
  6675.     cmp    #true        ; Did we receive successfully?
  6676.     bne    finsh1        ; No, try to send the packet again
  6677.     lda    ptype        ; Get the type
  6678.     cmp    #'Y        ; An ACK?
  6679.     bne    fince        ; No, go check for error
  6680.     jmp    kermit        ; Yes, go back for more commands
  6681. fince:    cmp    #'E        ; Error packet?
  6682.     bne    finsh1        ; Nope, resend packet
  6683.     jsr    prcerp        ;; Go display the error
  6684.     jmp    kermit        ; Go back for more 
  6685.  
  6686. .SBTTL    Get routine
  6687.  
  6688. ;
  6689. ;    This routine accepts an unquoted string terminated by 
  6690. ;    <cr>,<lf>,<ff>, or <esc> and tries to fetch the file
  6691. ;    represented by that string from a remote server Kermit.
  6692. ;
  6693.  
  6694. getfrs:
  6695.     jsr    openrs        ;[27] Reset the RS232 channel
  6696.     lda    #yes        ; Make KERMIT use file headers
  6697.     sta    usehdr        ;    for file names
  6698.     lda    #mxfnl+1    ; The buffer size is one more than max
  6699.     sta    kwrk01        ;    file name length
  6700.     lda    #fcb1\        ; Point to the buffer
  6701.     sta    kerto        ;        ...
  6702.     lda    #fcb1^        ;        ...
  6703.     sta    kerto+1        ;        ...
  6704.     jsr    kerflm        ; Clear the buffer
  6705.     lda    #$80        ; Reset all break characters
  6706.     jsr    rstbrk        ;        ...
  6707.     lda    #cr        ;        ...
  6708.     jsr    setbrk        ;        ...
  6709.     lda    #lf        ;        ...
  6710.     jsr    setbrk        ;        ...
  6711.     lda    #ffd        ;        ...
  6712.     jsr    setbrk        ;        ...
  6713.     lda    #esc        ;        ...
  6714.     jsr    setbrk        ;        ...
  6715.     ldy    #0        ;        ...
  6716.     lda    #cmtxt        ; Parse for text
  6717.     jsr    comnd        ; Do it
  6718.      jmp    kermta        ; Found null string
  6719.     cmp    spsiz        ; Larger than the set packet size?
  6720.     bmi    getf1        ; No, continue
  6721.     lda    spsiz        ; Yes, it will have to be truncated
  6722. getf1:    sta    kwrk01        ; Store packet size for Kercpy
  6723.     sta    pdlen        ;    and Spak
  6724.     lda    #pdbuf\        ; Point to the data buffer as destination
  6725.     sta    kerto        ;        ...
  6726.     sta    kerbf1        ; Store L.O.B. here for Spak routine
  6727.     lda    #pdbuf^        ;        ...
  6728.     sta    kerto+1        ;        ...
  6729.     sta    kerbf1+1    ; Store H.O.B. here for Spak routine
  6730.     stx    kerfrm        ; Point to the atom buffer from Comnd
  6731.     sty    kerfrm+1    ;    as the source address
  6732.     txa            ; Save the 'from buffer' pointers for later
  6733.     pha            ;        ...
  6734.     tya            ;        ...
  6735.     pha            ;        ...
  6736.     jsr    kercpy        ; Copy the string
  6737.     pla            ; Restore these for the next move
  6738.     sta    kerfrm+1    ;        ...
  6739.     pla            ;        ...
  6740.     sta    kerfrm        ;        ...
  6741.     lda    #fcb1\        ; Set up the address of the target
  6742.     sta    kerto        ;        ...
  6743.     lda    #fcb1^        ;        ...
  6744.     sta    kerto+1        ;        ...
  6745.     jsr    clrfcb        ; Clear the fcb first
  6746.     jsr    kercpy        ; Go move the string
  6747.     jsr    prcfm        ; Go parse and print the confirm
  6748.     lda    #'R        ; Packet type is 'Receive-init'
  6749.     sta    ptype        ;        ...
  6750.     lda    #0        ; Packet number should be zero
  6751.     sta    pnum        ;        ...
  6752.     jsr    spak        ; Packet length was set above, 
  6753.     jsr    rswt        ;    so just call spak and try to receive
  6754.     lda    #0        ; [jrd] make sure file's
  6755.     jsr    closef        ;  closed in case of error
  6756.     jmp    kermit        ; Go back for more commands
  6757.  
  6758.  
  6759. .SBTTL    Receve routine
  6760.  
  6761. ;
  6762. ;    This routine receives a file from the remote kermit and
  6763. ;    writes it to a disk file.
  6764. ;
  6765. ;        Input:  Filename returned from comnd, if any
  6766. ;
  6767. ;        Output: If file transfer is good, file is output to disk
  6768. ;
  6769. ;        Registers destroyed:    A,X,Y
  6770. ;
  6771.  
  6772. receve:    jsr    openrs        ;[27] Reset the RS232 channel
  6773.     lda    #on        ; Set use file-header switch on in case we
  6774.     sta    usehdr        ;    don't parse a filename
  6775.     lda    #kerehr\    ; Point to extra help commands
  6776.     sta    cmehpt        ;        ...
  6777.     lda    #kerehr^    ;        ...
  6778.     sta    cmehpt+1    ;        ...
  6779.     ldx    #mxfnl        ; Longest length a filename may be
  6780.     ldy    #cmfehf        ; Tell Comnd about extra help
  6781.     lda    #cmifi        ; Load opcode for parsing input files
  6782.     jsr    comnd        ; Call comnd routine
  6783.      jmp    recev1        ; Continue, don't turn file-header switch off
  6784.     sta    kwrk01        ; Store length of file parsed
  6785.     stx    kerfrm        ; Save the from address (addr[atmbuf])
  6786.     sty    kerfrm+1    ;        ...
  6787.     lda    #fcb1\        ; Save the to address (Fcb1)
  6788.     sta    kerto        ;        ...
  6789.     lda    #fcb1^        ;        ...
  6790.     sta    kerto+1        ;        ...
  6791.     jsr    clrfcb        ; Clear the fcb
  6792.     jsr    kercpy        ; Copy the string
  6793.     lda    #off        ; We parsed a filename so we don't need the
  6794.     sta    usehdr        ;    info from the file-header
  6795. recev1: ;lda    #cmcfm        ; Get token for confirm
  6796.     ;jsr    comnd        ;    and try to parse that
  6797.     ; jmp    kermt3        ; Failed - give the error
  6798.     jsr    prcfm        ;[] Parse and print a confirm
  6799.     jsr    rswt        ; Perform send-switch routine
  6800.     jsr    closers        ; [jrd] close com port
  6801.     jmp    kermit        ; Go back to main routine
  6802. ;
  6803. rswt:    lda    #'R        ; The state is receive-init
  6804.     sta    state        ; Set that up
  6805.     lda    #0        ; Zero the packet sequence number
  6806.     sta    n        ;        ...
  6807.     sta    numtry        ;    Number of tries
  6808.     sta    oldtry        ;    Old number of tries
  6809.     sta    eofinp        ;    End of input flag
  6810.     sta    errcod        ;    Error indicator
  6811.     sta    rtot        ;    Total received characters
  6812.     sta    rtot+1        ;        ...
  6813.     sta    stot        ;    Total Sent characters
  6814.     sta    stot+1        ;        ...
  6815.     sta    rchr        ;    Received characters, current file
  6816.     sta    rchr+1        ;        ...
  6817.     sta    schr        ;    and Sent characters, current file
  6818.     sta    schr+1        ;        ...
  6819.     sta    tpak        ;    and the total packet number
  6820.     sta    tpak+1        ;        ...
  6821. rswt1:  lda    state        ; Fetch the current system state
  6822.     cmp    #'D        ; Are we trying to receive data?
  6823.     bne    rswt2        ; If not, try the next one
  6824.     jsr    rdat        ; Go try for the data packet
  6825.     jmp    rswt1        ; Go back to the top of the loop
  6826. rswt2:  cmp    #'F        ; Do we need a file header packet?
  6827.     bne    rswt3        ; If not, continue checking
  6828.     jsr    rfil        ; Go get the file-header
  6829.     jmp    rswt1        ; Return to top of loop
  6830. rswt3:  cmp    #'R        ; Do we need the init?
  6831.     bne    rswt4        ; No, try next state
  6832.     jsr    rini        ; Yes, go get it
  6833.     jmp    rswt1        ; Go back to top
  6834. rswt4:  cmp    #'C        ; Have we completed the transfer?
  6835.     bne    rswt5        ; No, we are out of states, fail
  6836.     lda    #true        ; Load AC for true return
  6837.     rts            ; Return
  6838. rswt5:  lda    errcod        ; [jrd] get the error code
  6839.     jsr    prerms        ; [jrd] print apropos message
  6840.     lda    #false        ; Set up AC for false return
  6841.     rts            ; Return
  6842.  
  6843. rini:    lda    #pdbuf\        ; Point kerbf1 at the packet data buffer
  6844.     sta    kerbf1        ;        ...
  6845.     lda    #pdbuf^        ;        ...
  6846.     sta    kerbf1+1    ;        ...
  6847.     lda    numtry        ; Get current number of tries
  6848.     inc    numtry        ; Increment it for next time
  6849.     cmp    maxtry        ; Have we tried this one enougth times
  6850.     beq    rini1        ; Not yet, go on
  6851.     bcs    rini1a        ; Yup, go abort this transfer
  6852. rini1:  jmp    rini2        ; Continue
  6853. rini1a: lda    #'A        ; Change state to 'abort'
  6854.     sta    state        ;        ...
  6855.     lda    #errcri        ; Fetch the error index
  6856.     sta    errcod        ;    and store it as the error code
  6857.     lda    #false        ; Load AC with false status
  6858.     rts            ;    and return
  6859. rini2:  jsr    rpak        ; Go try to receive a packet
  6860.     sta    rstat        ; Store the return status for later
  6861.     lda    ptype        ; Fetch the packet type we got
  6862.     cmp    #'S        ; Was it an 'Init'?
  6863.     bne    rini2a        ; No, check the return status
  6864.     jmp    rinici        ; Go handle the init case
  6865. rini2a: lda    rstat        ; Fetch the saved return status
  6866.     cmp    #false        ; Is it false?
  6867.     beq    rini2b        ; Yes, just return with same state
  6868.     lda    #errcri        ; No, fetch the error index
  6869.     sta    errcod        ;    and store it as the error code
  6870.     jsr    prcerp        ; Check for error packet and process it
  6871.     lda    #'A        ; Abort this transfer
  6872.     sta    state        ; State is now 'abort'
  6873.     lda    #false        ; Set return status to 'false'
  6874.     rts            ; Return
  6875. rini2b: lda    n        ; Get packet sequence number expected
  6876.     sta    pnum        ; Stuff that parameter at the Nakit routine
  6877.     jsr    nakit        ; Go send the Nak
  6878.     lda    #false        ; Set up failure return status
  6879.     rts            ;    and go back
  6880.  
  6881. rinici: lda    pnum        ; Get the packet number we received
  6882.     sta    n        ; Synchronize our packet numbers with this
  6883.     jsr    rpar        ; Load in the init stuff from packet buffer
  6884.     jsr    spar        ; Stuff our init info into the packet buffer
  6885.     lda    #'Y        ; Store the 'Ack' code into the packet type
  6886.     sta    ptype        ;        ...
  6887.     lda    n        ; Get sequence number
  6888.     sta    pnum        ; Stuff that parameter
  6889. ;
  6890. ; This batch of code depends on the fact that the 'Y that the other side sends
  6891. ; gets stuffed into sebq if he's merely saying 'Yes I can', not 'OK, I will'.
  6892. ; 'Y''s not a legal char, so that has the effect of turning ebqmod off.
  6893. ;
  6894.     lda    sebq        ; See what we got for an 8-bit quoting
  6895.     cmp    #$21        ; First check the character range
  6896.     bmi    rinicn        ; Not in range
  6897.     cmp    #$3F        ;        ...
  6898.     bmi    rinicy        ; Inrange
  6899.     cmp    #$60        ;        ...
  6900.     bmi    rinicn        ; Not in range
  6901.     cmp    #$7F        ;        ...
  6902.     bmi    rinicy        ; Inrange
  6903. rinicn: lda    #off        ; No, punt 8-bit quoting
  6904.     sta    ebqmod        ;        ...
  6905.     lda    #6        ; BTW, the data length is now only 6
  6906.     jmp    rinic1        ; Continue
  6907. rinicy: lda    #on        ; Make sure everything is on
  6908.     sta    ebqmod        ;        ...
  6909.     lda    #7        ; Data length for ack-init is 7
  6910. rinic1: sta    pdlen        ; Store packet data length
  6911.     jsr    spak        ; Send that packet
  6912.     lda    numtry        ; Move the number of tries for this packet
  6913.     sta    oldtry        ;    to prev packet try count
  6914.     lda    #0        ; Zero
  6915.     sta    numtry        ;    the number of tries for current packet
  6916.     jsr    incn        ; Increment the packet number once
  6917.     lda    #'F        ; Advance to 'File-header' state
  6918.     sta    state        ;        ...
  6919.     lda    #true        ; Set up return code
  6920.     rts            ; Return
  6921.  
  6922. rfil:    lda    numtry        ; Get number of tries for this packet
  6923.     inc    numtry        ; Increment it for next time around
  6924.     cmp    maxtry        ; Have we tried too many times?
  6925.     beq    rfil1        ; Not yet
  6926.     bcs    rfil1a        ; Yes, go abort the transfer
  6927. rfil1:  jmp    rfil2        ; Continue transfer
  6928. rfil1a: lda    #'A        ; Set state of system to 'abort'
  6929.     sta    state        ;        ...
  6930.     lda    #false        ; Return code should be 'false'
  6931.     rts            ; Return
  6932. rfil2:  jsr    rpak        ; Try to receive a packet
  6933.     sta    rstat        ; Save the return status
  6934.     lda    ptype        ; Get the packet type we found
  6935.     cmp    #'S        ; Was it an 'init' packet?
  6936.     bne    rfil2a        ; Nope, try next one
  6937.     jmp    rfilci        ; Handle the init case
  6938. rfil2a: cmp    #'Z        ; Is it an 'eof' packet??
  6939.     bne    rfil2b        ; No, try again
  6940.     jmp    rfilce        ; Yes, handle that case
  6941. rfil2b: cmp    #'F        ; Is it a 'file-header' packet???
  6942.     bne    rfil2c        ; Nope
  6943.     jmp    rfilcf        ; Handle file-header case
  6944. rfil2c: cmp    #'B        ; Break packet????
  6945.     bne    rfil2d        ; Wrong, go get the return status
  6946.     jmp    rfilcb        ; Handle a break packet
  6947. rfil2d: lda    rstat        ; Fetch the return status from Rpak
  6948.     cmp    #false        ; Was it a false return?
  6949.     beq    rfil2e        ; Yes, Nak it and return
  6950.     lda    #errcrf        ; No, fetch the error index
  6951.     sta    errcod        ;    and store it as the error code
  6952.     jsr    prcerp        ; Check for error packet and process it
  6953.     lda    #'A        ; Abort this transfer
  6954.     sta    state        ;        ...
  6955.     lda    #false        ; Set up failure return code
  6956.     rts            ;    and return
  6957. rfil2e: lda    n        ; Move the expected packet number
  6958.     sta    pnum        ;    into the spot for the parameter
  6959.     jsr    nakit        ; Nak the packet
  6960.     lda    #false        ; Do a false return but don't change state
  6961.     rts            ; Return
  6962. rfilci: lda    oldtry        ; Get number of tries for prev packet
  6963.     inc    oldtry        ; Increment it
  6964.     cmp    maxtry        ; Have we tried this one too much?
  6965.     beq    rfili1        ; Not quite yet
  6966.     bcs    rfili2        ; Yes, go abort this transfer
  6967. rfili1: jmp    rfili3        ; Continue
  6968. rfili2:
  6969. rfili5: lda    #'A        ; Move abort code
  6970.     sta    state        ;    to system state
  6971.     lda    #errcrf        ; Fetch the error index
  6972.     sta    errcod        ;    and store it as the error code
  6973.     lda    #false        ; Prepare failure return
  6974.     rts            ;    and go back
  6975. rfili3: lda    pnum        ; See if pnum=n-1
  6976.     clc            ;        ...
  6977.     adc    #1        ;        ...
  6978.     cmp    n        ;        ...
  6979.     beq    rfili4        ; If it does, than we are ok
  6980.     jmp    rfili5        ; Otherwise, abort
  6981. rfili4: jsr    spar        ; Set up the init parms in the packet buffer
  6982.     lda    #'Y        ; Set up the code for Ack
  6983.     sta    ptype        ; Stuff that parm
  6984.     lda    #6        ; Packet length for init
  6985.     sta    pdlen        ; Stuff that also
  6986.     jsr    spak        ; Send the ack
  6987.     lda    #0        ; Clear out
  6988.     sta    numtry        ;    the number of tries for current packet
  6989.     lda    #true        ; This is ok, return true with current state
  6990.     rts            ; Return
  6991. rfilce: lda    oldtry        ; Get number of tries for previous packet
  6992.     inc    oldtry        ; Up it for next time we have to do this
  6993.     cmp    maxtry        ; Too many times for this packet?
  6994.     beq    rfile1        ; Not yet, continue
  6995.     bcs    rfile2        ; Yes, go abort it
  6996. rfile1: jmp    rfile3        ;        ...
  6997. rfile2:
  6998. rfile5:    lda    #'A        ; Load abort code
  6999.     sta    state        ;    into current system state
  7000.     lda    #errcrf        ; Fetch the error index
  7001.     sta    errcod        ;    and store it as the error code
  7002.     lda    #false        ; Prepare failure return
  7003.     rts            ;    and return
  7004. rfile3:    lda    pnum        ; First, see if pnum=n-1
  7005.     clc            ;        ...
  7006.     adc    #1        ;        ...
  7007.     cmp    n        ;        ...
  7008.     beq    rfile4        ; If so, continue
  7009.     jmp    rfile5        ; Else, abort it
  7010. rfile4: lda    #'Y        ; Load 'ack' code
  7011.     sta    ptype        ; Stuff that in the packet type
  7012.     lda    #0        ; This packet will have a packet data length
  7013.     sta    pdlen        ;    of zero
  7014.     jsr    spak        ; Send the packet out
  7015.     lda    #0        ; Zero number of tries for current packet
  7016.     sta    numtry        ;        ...
  7017.     lda    #true        ; Set up successful return code
  7018.     rts            ;    and return
  7019. rfilcf: lda    pnum        ; Does pnum=n?
  7020.     cmp    n        ;        ...
  7021.     bne    rfilf1        ; If not, abort
  7022.     jmp    rfilf2        ; Else, we can continue
  7023. rfilf1:    lda    #'A        ; Load the abort code
  7024.     sta    state        ;    and stuff it as current system state
  7025.     lda    #errcrf        ; Fetch the error index
  7026.     sta    errcod        ;    and store it as the error code
  7027.     lda    #false        ; Prepare failure return
  7028.     rts            ;    and go back
  7029. rfilf2: jsr    getfil        ; Get the filename we are to use
  7030.     lda    #fncwrt        ; Tell the open routine we want to write
  7031.     jsr    openf        ; Open up the file
  7032.     jsr    logrcv        ; tell user what we're receiving
  7033.     lda    #'Y        ; Stuff code for 'ack'
  7034.     sta    ptype        ; Into packet type parm
  7035.     lda    #0        ; Stuff a zero in as the packet data length
  7036.     sta    pdlen        ;        ...
  7037.     jsr    spak        ; Ack the packet
  7038.     lda    numtry        ; Move current tries to previous tries
  7039.     sta    oldtry        ;        ...
  7040.     lda    #0        ; Clear the
  7041.     sta    numtry        ; Number of tries for current packet
  7042.     jsr    incn        ; Increment the packet sequence number once
  7043.     lda    #'D        ; Advance the system state to 'receive-data'
  7044.     sta    state        ;        ...
  7045.     lda    #true        ; Set up success return
  7046.     rts            ;    and go back
  7047. rfilcb: lda    pnum        ; Does pnum=n?
  7048.     cmp    n        ;        ...
  7049.     bne    rfilb1        ; If not, abort the transfer process
  7050.     jmp    rfilb2        ; Otherwise, we can continue
  7051. rfilb1:    lda    #'A        ; Code for abort
  7052.     sta    state        ; Stuff that into system state
  7053.     lda    #errcrf        ; Fetch the error index
  7054.     sta    errcod        ;    and store it as the error code
  7055.     lda    #false        ; Load failure return status
  7056.     rts            ;    and return
  7057. rfilb2: lda    #'Y        ; Set up 'ack' packet type
  7058.     sta    ptype        ;        ...
  7059.     lda    #0        ; Zero out
  7060.     sta    pdlen        ;    the packet data length
  7061.     jsr    spak        ; Send out this packet
  7062.     lda    #'C        ; Advance state to 'complete'
  7063.     sta    state        ;    since we are now done with the transfer
  7064.     lda    #true        ; Return a true
  7065.     rts            ;        ...
  7066.  
  7067. rdat:    lda    numtry        ; Get number of tries for current packet
  7068.     inc    numtry        ; Increment it for next time around
  7069.     cmp    maxtry        ; Have we gone beyond number of tries allowed?
  7070.     beq    rdat1        ; Not yet, so continue
  7071.     bcs    rdat1a        ; Yes, we have, so abort
  7072. rdat1:  jmp    rdat2        ;        ...
  7073. rdat1a: lda    #'A        ; Code for 'abort' state
  7074.     sta    state        ; Stuff that in system state
  7075.     lda    #errcrd        ; Fetch the error index
  7076.     sta    errcod        ;    and store it as the error code
  7077.     lda    #false        ; Set up failure return code
  7078.     rts            ;    and go back
  7079. rdat2:  jsr    rpak        ; Go try to receive a packet
  7080.     sta    rstat        ; Save the return status for later
  7081.     lda    ptype        ; Get the type of packet we just picked up
  7082.     cmp    #'D        ; Was it a data packet?
  7083.     bne    rdat2a        ; If not, try next type
  7084.     jmp    rdatcd        ; Handle a data packet
  7085. rdat2a: cmp    #'F        ; Is it a file-header packet?
  7086.     bne    rdat2b        ; Nope, try again
  7087.     jmp    rdatcf        ; Go handle a file-header packet
  7088. rdat2b: cmp    #'Z        ; Is it an eof packet???
  7089.     bne    rdat2c        ; If not, go check the return status from rpak
  7090.     jmp    rdatce        ; It is, go handle eof processing
  7091. rdat2c: lda    rstat        ; Fetch the return status
  7092.     cmp    #false        ; Was it a failure return?
  7093.     beq    rdat2d        ; If it was, Nak it
  7094.     lda    #errcrd        ; Fetch the error index
  7095.     sta    errcod        ;    and store it as the error code
  7096.     jsr    prcerp        ; Check for error packet and process it
  7097.     lda    #'A        ; Give up the whole transfer
  7098.     sta    state        ; Set system state to 'false'
  7099.     lda    #false        ; Set up a failure return
  7100.     rts            ;    and go back
  7101. rdat2d: lda    n        ; Get the expected packet number
  7102.     sta    pnum        ; Stuff that parameter for Nak routine
  7103.     jsr    nakit        ; Send a Nak packet
  7104.     lda    #false        ; Give failure return
  7105.     rts            ; Go back
  7106.  
  7107. rdatcd: lda    pnum        ; Is pnum the right sequence number?
  7108.     cmp    n        ;        ...
  7109.     bne    rdatd1        ; If not, try another approach
  7110.     jmp    rdatd7        ; Otherwise, everything is fine
  7111. rdatd1: lda    oldtry        ; Get number of tries for previous packet
  7112.     inc    oldtry        ; Increment it for next time we need it
  7113.     cmp    maxtry        ; Have we exceeded that limit?
  7114.     beq    rdatd2        ; Not just yet, continue
  7115.     bcs    rdatd3        ; Yes, go abort the whole thing
  7116. rdatd2: jmp    rdatd4        ; Just continue working on the thing
  7117. rdatd3:
  7118. rdatd6:    lda    #'A        ; Load 'abort' code into the
  7119.     sta    state        ;    current system state
  7120.     lda    #errcrd        ; Fetch the error index
  7121.     sta    errcod        ;    and store it as the error code
  7122.     lda    #false        ; Make this a failure return
  7123.     rts            ; Return
  7124. rdatd4: lda    pnum        ; Is pnum=n-1... Is the received packet
  7125.     clc            ;    the one previous to the currently
  7126.     adc    #1        ;    expected packet?
  7127.     cmp    n        ;        ...
  7128.     beq    rdatd5        ; Yes, continue transfer
  7129.     jmp    rdatd6        ; Nope, abort the whole thing
  7130. rdatd5: jsr    spar        ; Go set up init data
  7131.     lda    #'Y        ; Make it look like an ack to a send-init
  7132.     sta    ptype        ;        ...
  7133.     lda    #6        ;        ...
  7134.     sta    pdlen        ;        ...
  7135.     jsr    spak        ; Go send the ack
  7136.     lda    #0        ; Clear the
  7137.     sta    numtry        ;    number of tries for current packet
  7138.     lda    #true        ;        ...
  7139.     rts            ; Return (successful!)
  7140. rdatd7: 
  7141.     jsr    closers        ; [jrd] Close port while doing disk things
  7142.                 ;  spak or rpak will reopen it
  7143.     jsr    bufemp        ; Go empty the packet buffer
  7144. ;
  7145. ; [jrd]    if losing, send an abort
  7146. ;
  7147.     cmp    #true        ; [jrd] we win?
  7148.     bne    rdatd8        ; [jrd] nope, go abort xfer
  7149. ;
  7150.     lda    #'Y        ; Set up an ack packet
  7151.     sta    ptype        ;        ...
  7152.     lda    n        ;        ...
  7153.     sta    pnum        ;        ...
  7154.     lda    #0        ; Don't forget, there is no data
  7155.     sta    pdlen        ;        ...
  7156.     jsr    spak        ; Send it!
  7157.     lda    numtry        ; Move tries for current packet count to
  7158.     sta    oldtry        ;    tries for previous packet count
  7159.     lda    #0        ; Zero the
  7160.     sta    numtry        ;    number of tries for current packet
  7161.     jsr    incn        ; Increment the packet sequence number once
  7162.     lda    #'D        ; Advance the system state to 'receive-data'
  7163.     sta    state        ;        ...
  7164.     lda    #true        ;        ...
  7165.     rts            ; Return (successful)
  7166. ;
  7167. ; all this added by jrd
  7168. rdatd8:    lda    #'A        ; set packet type
  7169.     sta    ptype
  7170.     lda    #0        ; set data length
  7171.     sta    pdlen
  7172.     jsr    spak        ; send it
  7173.     lda    #'A        ; set
  7174.     sta    state        ;  rswt machine state
  7175.     lda    #0        ; Make CLOSEF see there are no errors
  7176.     jsr    closef        ; We are done with this file, so close it
  7177.     lda    #false        ; say we lost
  7178.     rts            ; and return
  7179. ;
  7180. rdatcf: lda    oldtry        ; Fetch number of tries for previous packet
  7181.     inc    oldtry        ; Increment it for when we need it again
  7182.     cmp    maxtry        ; Have we exceeded maximum tries allowed?
  7183.     beq    rdatf1        ; Not yet, go on
  7184.     bcs    rdatf2        ; Yup, we have to abort this thing
  7185. rdatf1: jmp    rdatf3        ; Just continue the transfer
  7186. rdatf2:
  7187. rdatf5:    lda    #'A        ; Move 'abort' code to current system state
  7188.     sta    state        ;        ...
  7189.     lda    #errcrd        ; Fetch the error index
  7190.     sta    errcod        ;    and store it as the error code
  7191.     lda    #false        ;        ...
  7192.     rts            ;    and return false
  7193. rdatf3: lda    pnum        ; Is this packet the one before the expected
  7194.     clc            ;    one?
  7195.     adc    #1        ;        ...
  7196.     and    #$3F        ; [jrd]
  7197.     cmp    n        ;        ...
  7198.     beq    rdatf4        ; If so, we can still ack it
  7199.     jmp    rdatf5        ; Otherwise, we should abort the transfer
  7200. rdatf4: lda    #'Y        ; Load 'ack' code
  7201.     sta    ptype        ; Stuff that parameter
  7202.     lda    #0        ; Use zero as the packet data length
  7203.     sta    pdlen        ;        ...
  7204.     jsr    spak        ; Send it!
  7205.     lda    #0        ; Zero the number of tries for current packet
  7206.     sta    numtry        ;        ...
  7207.     lda    #true        ;        ...
  7208.     rts            ; Return (successful)
  7209.  
  7210. rdatce: lda    pnum        ; Is this the packet we are expecting?
  7211.     cmp    n        ;        ...
  7212.     bne    rdate1        ; No, we should go abort
  7213.     jmp    rdate2        ; Yup, go handle it
  7214. rdate1:    lda    #'A        ; Load 'abort' code into
  7215.     sta    state        ;    current system state
  7216.     lda    #errcrd        ; Fetch the error index
  7217.     sta    errcod        ;    and store it as the error code
  7218.     lda    #false        ;        ...
  7219.     rts            ; Return (failure)
  7220. rdate2:
  7221. ;    lda    #fcb1\        ; Get the pointer to the fcb
  7222. ;    sta    kerfcb        ;    and store it where the close routine
  7223. ;    lda    #fcb1^        ;    can find it
  7224. ;    sta    kerfcb        ;        ...
  7225.     lda    #0        ; Make CLOSEF see there are no errors
  7226.     jsr    closef        ; We are done with this file, so close it
  7227. ; ?!?!    jsr    incn        ; Increment the packet number
  7228.     lda    #'Y        ; Get set up for the ack
  7229.     sta    ptype        ; Stuff the packet type
  7230.     lda    n        ;    packet number
  7231.     sta    pnum        ;        ...
  7232.     lda    #0        ;    and packet data length
  7233.     sta    pdlen        ;    parameters
  7234.     jsr    spak        ; Go send it!
  7235. ;
  7236. ; zzzzz try this here
  7237. ;
  7238.     jsr    incn        ; Increment the packet number
  7239.     lda    #'F        ; Advance system state to 'file-header'
  7240.     sta    state        ;    incase more files are coming
  7241.     lda    #true        ;        ...
  7242.     rts            ; Return (successful)
  7243.  
  7244. ;
  7245. ;    stuff for mapping ops over filenames.
  7246. ;
  7247. ;    state vars
  7248. ;
  7249. diropen: .byte    0        ; if directory in progress
  7250. direof:    .byte    0        ; if we've run out of files
  7251. dirspec: .byte    "                 " ; room for max pn + ATEOL
  7252. ;
  7253.  
  7254. ;    dirini:        init the directory stuff.  Expects a pathname 
  7255. ;            in path.
  7256. dirini:
  7257.     jsr    dircls        ; make sure dir closed first
  7258.     lda    #path\        ; point at the pathname struct
  7259.     sta    pndptr
  7260.     lda    #path^
  7261.     sta    pndptr+1
  7262.     ldx    #dirspec\    ; and point at the string
  7263.     ldy    #dirspec^
  7264.     jsr    pn2str        ; convert pathname to string
  7265. ;
  7266. dirrini:            ; entry pt for re-init
  7267.     lda    #dirspec\    ; get string addr
  7268.     ldy    #dirspec^
  7269.     ldx    #dirchan    ; get dir iocb
  7270.     jsr    opencdir    ; open directory
  7271.     cpy    #SUCCES        ; did we win?
  7272.     bne    dirini9        ; nope, go die
  7273.     lda    #1        ; say we've got it open
  7274.     sta    diropen
  7275.     lda    #0        ; and that it's not yet at eof
  7276.     sta    direof
  7277.     rts            ; done!
  7278. dirini9:
  7279.     lda    #0        ; say it's not open
  7280.     sta    diropen
  7281.     jsr    closec        ; make sure closed again
  7282.     rts
  7283. ;
  7284. ;    dircls:        Close the dir channel if it's open
  7285. ;
  7286. dircls:
  7287.     lda    diropen        ; open?
  7288.     beq    dircls9        ; nope, go home
  7289.     ldx    #dirchan    ; get the dir iocb
  7290.     jsr    closec        ; and close it
  7291.     lda    #0        ; say it's not open any more
  7292.     sta    diropen
  7293. dircls9:
  7294.     rts            ; home!
  7295. ;
  7296. ;    dirnxt:        Get next entry in the directory into dirpath.
  7297. ;            Returns carry clear if wins, carry set if lose
  7298. ;
  7299. dirnxt:
  7300.     lda    diropen        ; won't work if it's not open
  7301.     bne    dirnxt0        ; We're ok
  7302.     jmp    dirnxt9        ; Oops! No good
  7303. dirnxt0:
  7304.     ldx    #dirchan    ; get the dir iocb
  7305.     jsr    chrin        ; get a char
  7306.     sta    dirplck        ; save the 'locked' flag
  7307.     cmp    #space        ; good entries start with
  7308.     beq    dirnxt1        ;  space or star
  7309.     cmp    #'*
  7310.     bne    dirnxt8        ; end of dir, close up and leave
  7311. dirnxt1:
  7312.     jsr    chrin        ; skip this char
  7313.     ldy    #0        ; zap length of name fld
  7314.     sty    dirpath+pnd.ns    ; really should do something general...
  7315.     ldy    #8        ; length of name fld
  7316.     sty    source        ; used as temp
  7317. dirnxt2:
  7318.     jsr    chrin        ; get a byte
  7319.     cmp    #space        ; end of name?
  7320.     beq    dirnxt3        ; yup, don't push this one
  7321.     ldy    dirpath+pnd.ns    ; get name comp size
  7322.     sta    dirpath+pnd.nt,y    ; and shove the byte
  7323.     iny            ; bump size
  7324.     sty    dirpath+pnd.ns    ; and put it back
  7325. dirnxt3:
  7326.     dec    source        ; dec counter
  7327.     bne    dirnxt2        ; not done yet, go round again
  7328.     ldy    #0        ; zap length of ext fld
  7329.     sty    dirpath+pnd.es    ; really should do something general...
  7330.     ldy    #3        ; length of ext fld
  7331.     sty    source        ; used as temp
  7332. dirnxt4:
  7333.     jsr    chrin        ; get a byte
  7334.     cmp    #space        ; end of ext?
  7335.     beq    dirnxt5        ; yup, don't push this one
  7336.     ldy    dirpath+pnd.es    ; get ext comp size
  7337.     sta    dirpath+pnd.et,y    ; and shove the byte
  7338.     iny            ; bump size
  7339.     sty    dirpath+pnd.es    ; and put it back
  7340. dirnxt5:
  7341.     dec    source        ; dec counter
  7342.     bne    dirnxt4        ; not done yet, go round again
  7343. ;
  7344. ; done with name.  collect the sector count.
  7345. ;
  7346. dirnxt6:
  7347.     jsr    chrin        ; ignore this one
  7348.     jsr    chrin
  7349.     sta    dirsect
  7350.     jsr    chrin
  7351.     sta    dirsect+1
  7352.     jsr    chrin
  7353.     sta    dirsect+2
  7354. dirnxt6a:
  7355.     cmp    #ATEOL        ; shouldn't be the first time, but be safe
  7356.     beq    dirnxt7
  7357.     jsr    chrin
  7358.     jmp    dirnxt6a:
  7359. dirnxt7:
  7360.     
  7361. ;
  7362. ; set bits in name
  7363. ;
  7364.     lda    #pnf.np!pnf.ep
  7365.     sta    dirpath+pnd.fl
  7366.     clc            ; say we've got one
  7367.     rts            ; and return
  7368. dirnxt8:            ; copy rest of dir str someplace
  7369.                 ;  (primfn will do)
  7370.     sta    primfn        ; that's the first byte
  7371.     ldy    #1        ; that'll be the idx
  7372.     sty    strptr        ; temp
  7373. dirnxt8a:
  7374.     jsr    chrin        ; get a byte
  7375.     ldy    strptr        ; get idx back
  7376.     sta    primfn,y    ; store the byte
  7377.     iny            ; bump
  7378.     sty    strptr        ;  and save it
  7379.     cmp    #ATEOL        ; end of line?
  7380.     bne    dirnxt8a    ; nope, do some more
  7381.     jsr    dircls        ; done, close up
  7382. dirnxt9:
  7383.     sec            ; say we lose
  7384.     rts            ; and return
  7385.  
  7386. ;
  7387. ;.SBTTL    Send routine
  7388.  
  7389. ;
  7390. ;    This routine reads a file from disk and sends packets
  7391. ;    of data to the remote kermit.
  7392. ;
  7393. ;        Input:  Filename returned from Comnd routines
  7394. ;
  7395. ;        Output: File is sent over port
  7396. ;
  7397. ;        Registers destroyed:    A,X,Y
  7398. ;
  7399.  
  7400. send:
  7401. ;
  7402. ; old send startup code commented out while debugging wildcard stuff
  7403. ;    ldx    #mxfnl        ; Longest length a filename may be
  7404. ;    ldy    #0        ; No special flags needed
  7405. ;    lda    #cmifi        ; Load opcode for parsing input files
  7406. ;    jsr    comnd        ; Call comnd routine
  7407. ;     jmp    kermt6        ; Give the 'missing filespec' error
  7408. ;    sta    kwrk01        ; Store length of file parsed
  7409. ;    stx    kerfrm        ; Save the from address (addr[atmbuf])
  7410. ;    sty    kerfrm+1    ;        ...
  7411. ;    lda    #fcb1\        ; Save the to address (Fcb1)
  7412. ;    sta    kerto        ;        ...
  7413. ;    lda    #fcb1^        ;        ...
  7414. ;    sta    kerto+1        ;        ...
  7415. ;    jsr    clrfcb        ; Clear the fcb
  7416. ;    jsr    kercpy        ; Copy the string
  7417. ;    ldy    kwrk01        ; Get filename length
  7418. ;;zzzzz    lda    #nul        ; Fetch a null character
  7419. ;    lda    #ATEOL        ; terminate with eol zzz?
  7420. ;    sta    (kerto),y    ; Stuff a null at end-of-buffer
  7421. ;-----
  7422.     lda    #0        ; allow default of *.*
  7423.     jsr    enterpn        ;  and get a pathname
  7424.     jsr    prcfm        ; confirm it
  7425.     jsr    parsefcb    ; parse and merge the resultant filespec
  7426.     jsr    closers        ; make sure comm port's closed
  7427.     jsr    bldprm        ; [jrd] reformat it
  7428.     jsr    dirini
  7429.     lda    #0        ; zap
  7430.     sta    ssfidx        ;  the file idx
  7431.     jsr    ssfnxt        ; [jrd] get the first file
  7432.     bcs    send9        ; zzz print error if no match
  7433. ;----
  7434.     jsr    openrs        ;[27] Reset the RS232 channel
  7435.     jsr    sswt        ; Perform send-switch routine
  7436.     jsr    closers        ; [jrd] close comm port
  7437.     jsr    closef        ; make sure file closed
  7438. send9:
  7439.     jmp    kermit        ; Go back to main routine
  7440.  
  7441. ;
  7442. ; util for dealing with getting next file set up, etc.  Leaves
  7443. ; fcb1 with name.ext in it.  Returns carry set if fails.  Leaves 
  7444. ; directory stream closed, so as not to confuse OS by opening 
  7445. ; file while directory's open
  7446. ;
  7447. ssfidx:    .byte    0        ; how many files we've done
  7448. ssfnxt:
  7449.     jsr    closers        ; make sure comm's closed
  7450.     lda    ssfidx        ; get file nbr
  7451.     beq    ssfnx0        ; first time?  ok, just go ahead
  7452.     pha            ; save the old idx
  7453.     jsr    dirrini        ; reinit directory to value from last time
  7454. ssfnsk:                ; skip the next file entry
  7455.     jsr    dirnxt        ; get next entry
  7456.     bcc    ssfnsk1        ; more here...
  7457.     pla            ; oops! no more, flush dead val
  7458.     jmp    ssfnx9        ;  on stack and return error
  7459. ssfnsk1:
  7460.     dec    ssfidx        ; dec count of files we've done
  7461.     bne    ssfnsk        ; still more, keep skipping
  7462.     pla            ; get original count back
  7463.     sta    ssfidx        ; save it
  7464. ssfnx0:                ; done skipping, take the next one
  7465.     jsr    dirnxt        ; get one
  7466.     bcc    ssfnx1        ; succeeded, go ahead
  7467. ssfnx9:    jsr    dircls        ; failed, close up,
  7468.     sec            ; and return error
  7469.     rts
  7470. ssfnx1:
  7471.     lda    #dirpath\    ; point at the pathname struct
  7472.     sta    pndptr
  7473.     lda    #dirpath^
  7474.     sta    pndptr+1
  7475.     ldx    #fcb1\        ; and point at the string
  7476.     ldy    #fcb1^
  7477.     jsr    pn2str        ; convert pathname to string
  7478.     jsr    dircls        ; close dir so we can hack file
  7479.     inc    ssfidx        ; say we've done this one
  7480.     clc            ; return success code
  7481.     rts
  7482. ;
  7483. ; 
  7484. sswt:    lda    #'S        ; Set up state variable as
  7485.     sta    state        ;    Send-init
  7486.     lda    #0        ; Clear
  7487.     sta    eodind        ;    The End-of-Data indicator
  7488.     sta    n        ;    Packet number
  7489.     sta    numtry        ;    Number of tries
  7490.     sta    oldtry        ;    Old number of tries
  7491.     sta    eofinp        ;    End of input flag
  7492.     sta    errcod        ;    Error indicator
  7493.     sta    rtot        ;    Total received characters
  7494.     sta    rtot+1        ;        ...
  7495.     sta    stot        ;    Total Sent characters
  7496.     sta    stot+1        ;        ...
  7497.     sta    rchr        ;    Received characters, current file
  7498.     sta    rchr+1        ;        ...
  7499.     sta    schr        ;    and Sent characters, current file
  7500.     sta    schr+1        ;        ...
  7501.     sta    tpak        ;    and the total packet number
  7502.     sta    tpak+1        ;        ...
  7503.     lda    #pdbuf\        ; Set up the address of the packet buffer
  7504.     sta    saddr        ;    so that we can clear it out
  7505.     lda    #pdbuf^        ;        ...
  7506.     sta    saddr+1        ;        ...
  7507.     lda    #0        ; Clear AC
  7508.     ldy    #0        ; Clear Y
  7509. clpbuf: sta    (saddr),y    ; Step through buffer, clearing it out
  7510.     iny            ; Up the index
  7511.     cpy    #mxpack-4    ; Done?
  7512.     bmi    clpbuf        ; No, continue
  7513. sswt1:  lda    state        ; Fetch state of the system
  7514.     cmp    #'D        ; Do Send-data?
  7515.     bne    sswt2        ; No, try next one
  7516.     jsr    sdat        ; Yes, send a data packet
  7517.     jmp    sswt1        ; Go to the top of the loop
  7518. sswt2:  cmp    #'F        ; Do we want to send-file-header?
  7519.     bne    sswt3        ; No, continue
  7520.     jsr    sfil        ; Yes, send a file header packet
  7521.     jmp    sswt1        ; Return to top of loop
  7522. sswt3:  cmp    #'Z        ; Are we due for an Eof packet?
  7523.     bne    sswt4        ; Nope, try next state
  7524.     jsr    seof        ; Yes, do it
  7525.     jmp    sswt1        ; Return to top of loop
  7526. sswt4:  cmp    #'S        ; Must we send an init packet
  7527.     bne    sswt5        ; No, continue
  7528.     jsr    sini        ; Yes, go do it
  7529.     jmp    sswt1        ; And continue
  7530. sswt5:  cmp    #'B        ; Time to break the connection?
  7531.     bne    sswt6        ; No, try next state
  7532.     jsr    sbrk        ; Yes, go send a break packet
  7533.     jmp    sswt1        ; Continue from top of loop
  7534. sswt6:  cmp    #'C        ; Is the entire transfer complete?
  7535.     bne    sswt7        ; No, something is wrong, go abort
  7536.     lda    #true        ; Return true
  7537.     rts            ;        ...
  7538. sswt7:  lda    errcod        ; [jrd] get the error code
  7539.     jsr    prerms        ; [jrd] print apropos message
  7540.     lda    #false        ; Return false
  7541.     rts            ;        ...
  7542.  
  7543. sdat:    lda    numtry        ; Fetch the number for tries for current packet
  7544.     inc    numtry        ; Add one to it
  7545.     cmp    maxtry        ; Is it more than the maximum allowed?
  7546.     beq    sdat1        ; No, not yet
  7547.     bcs    sdat1a        ; If it is, go abort
  7548. sdat1:  jmp    sdat1b        ; Continue
  7549. sdat1a: lda    #'A        ; Load the 'abort' code
  7550.     sta    state        ; Stuff that in as current state
  7551.     lda    #false        ; Enter false return code
  7552.     rts            ;    and return
  7553. sdat1b: lda    #'D        ; Packet type will be 'Send-data'
  7554.     sta    ptype        ;        ...
  7555.     lda    n        ; Get packet sequence number
  7556.     sta    pnum        ; Store that parameter to Spak
  7557.     lda    size        ; This is the size of the data in the packet
  7558.     sta    pdlen        ; Store that where it belongs
  7559.     jsr    spak        ; Go send the packet
  7560. sdat2:  jsr    rpak        ; Try to get an ack
  7561.     sta    rstat        ; First, save the return status
  7562.     lda    ptype        ; Now get the packet type received
  7563.     cmp    #'N        ; Was it a NAK?
  7564.     bne    sdat2a        ; No, try for an ACK
  7565.     jmp    sdatcn        ; Go handle the nak case
  7566. sdat2a: cmp    #'Y        ; Did we get an ACK?
  7567.     bne    sdat2b        ; No, try checking the return status
  7568.     jmp    sdatca        ; Yes, handle the ack
  7569. sdat2b: lda    rstat        ; Fetch the return status
  7570.     cmp    #false        ; Failure return?
  7571.     beq    sdat2c        ; Yes, just return with current state
  7572.     jsr    prcerp        ; Check for error packet and process it
  7573.     lda    #'A        ; Stuff the abort code
  7574.     sta    state        ;    as the current system state
  7575.     lda    #false        ; Load failure return code
  7576. sdat2c: rts            ; Go back
  7577. sdatcn: dec    pnum        ; Decrement the packet sequence number
  7578.     lda    n        ; Get the expected packet sequence number
  7579.     cmp    pnum        ; If n=pnum-1 then this is like an ack
  7580.     bne    sdatn1        ; No, continue handling the nak
  7581.     jmp    sdata2        ; Jump to ack bypassing sequence check
  7582. sdata1:
  7583. sdatn1: lda    #false        ; Failure return
  7584.     rts            ;        ...
  7585. sdatca: lda    n        ; First check packet number
  7586.     cmp    pnum        ; Did he ack the correct packet?
  7587.     bne    sdata1        ; No, go give failure return
  7588. sdata2: lda    #0        ; Zero out number of tries for current packet
  7589.     sta    numtry        ;        ...
  7590.     jsr    incn        ; Increment the packet sequence number
  7591.     jsr    closers        ; [jrd] Close port while doing disk things.
  7592.                 ;  spak or rpak will re-open it
  7593.     jsr    bufill        ; Go fill the packet buffer with data
  7594.     sta    size        ; Save the data size returned
  7595.     lda    eofinp        ; Load end-of-file indicator
  7596.     cmp    #true        ; Was this set by Bufill?
  7597.     beq    sdatrz        ; If so, return state 'Z' ('Send-eof')
  7598.     jmp    sdatrd        ; Otherwise, return state 'D' ('Send-data')
  7599. sdatrz:    lda    #0        ; Clear
  7600.     sta    eofinp        ;    End of input flag
  7601. ;    lda    #fcb1\        ; Get the pointer to the fcb
  7602. ;    sta    kerfcb        ;    and store it where the close routine
  7603. ;    lda    #fcb1^        ;    can find it
  7604. ; zzz    sta    kerfcb        ;        ...
  7605.     lda    #0        ; Make CLOSEF see there are no errors
  7606.     jsr    closef        ; We are done with this file, so close it.  Closes rs
  7607.     lda    #'Z        ; Load the Eof code
  7608.     sta    state        ;    and make it the current system state
  7609.     lda    #true        ; We did succeed, so give a true return
  7610.     rts            ; Go back
  7611. sdatrd: lda    #'D        ; Load the Data code
  7612.     sta    state        ; Set current system state to that
  7613.     lda    #true        ; Set up successful return
  7614.     rts            ;    and go back
  7615.  
  7616. sfil:
  7617. sfil0:    lda    numtry        ; Fetch the current number of tries
  7618.     inc    numtry        ; Up it by one
  7619.     cmp    maxtry        ; See if we went up to too many
  7620.     beq    sfil1        ; Not yet
  7621.     bcs    sfil1a        ; Yes, go abort
  7622. sfil1:    jmp    sfil1b        ; If we are still ok, take this jump
  7623. sfil1a:    lda    #'A        ; Load code for abort
  7624.     sta    state        ;    and drop that in as the current state
  7625.     lda    #false        ; Load false for a return code
  7626.     rts            ;    and return
  7627. sfil1b:    ldy    #0        ; Clear Y
  7628. sfil1c:    lda    fcb1,y        ; Get a byte from the filename
  7629.     cmp    #0        ; Is it a null?
  7630.     beq    sfil1d        ; No, continue
  7631. ; zzz    cmp    #$20        ; <sp>?
  7632.     cmp    #ATEOL        ; end of file name in Atari-land?
  7633.     beq    sfil1d        ;[DD]
  7634.     sta    pdbuf,y        ; Move the byte to this buffer
  7635.     iny            ; Up the index once
  7636.     jmp    sfil1c        ; Loop and do it again
  7637. sfil1d:    sty    pdlen        ; This is the length of the filename
  7638.     lda    #'F        ; Load type ('Send-file')
  7639.     sta    ptype        ; Stuff that in as the packet type
  7640.     lda    n        ; Get packet number
  7641.     sta    pnum        ; Store that in its common area
  7642.     jsr    spak        ; Go send the packet
  7643. sfil2:    jsr    rpak        ; Go try to receive an ack
  7644.     sta    rstat        ; Save the return status
  7645.     lda    ptype        ; Get the returned packet type
  7646.     cmp    #'N        ; Is it a NAK?
  7647.     bne    sfil2a        ; No, try the next packet type
  7648.     jmp    sfilcn        ; Handle the case of a nak
  7649. sfil2a:    cmp    #'Y        ; Is it, perhaps, an ACK?
  7650.     bne    sfil2b        ; If not, go to next test
  7651.     jmp    sfilca        ; Go and handle the ack case
  7652. sfil2b:    lda    rstat        ; Get the return status
  7653.     cmp    #false        ; Is it a failure return?
  7654.     bne    sfil2c        ; No, just go abort the send
  7655.     rts            ; Return failure with current state
  7656. sfil2c:    jsr    prcerp        ; Check for error packet and process it
  7657.     lda    #'A        ; Set state to 'abort'
  7658.     sta    state        ; Stuff it in its place
  7659.     lda    #false        ; Set up a failure return code
  7660.     rts            ;    and go back
  7661. sfilcn:    dec    pnum        ; Decrement the receive packet number once
  7662.     lda    pnum        ; Load it into the AC
  7663.     cmp    n        ; Compare that with what we are looking for
  7664.     bne    sfiln1        ; If n=pnum-1 then this is like an ack, do it
  7665.     jmp    sfila2        ; This is like an ack
  7666. sfila1:    
  7667. sfiln1:    lda    #false        ; Load failure return code
  7668.     rts            ;    and return
  7669. sfilca:    lda    n        ; Get the packet number
  7670.     cmp    pnum        ; Is that the one that was acked?
  7671.     bne    sfila1        ; They are not equal
  7672. sfila2:    lda    #0        ; Clear AC
  7673.     sta    numtry        ; Zero the number of tries for current packet
  7674.     jsr    incn        ; Up the packet sequence number
  7675. ;    lda    #fcb1\        ; Load the fcb address into the pointer
  7676. ;    sta    kerfcb        ;    for the DOS open routine
  7677. ;    lda    #fcb1^        ;        ...
  7678. ; zzz    sta    kerfcb+1    ;        ...
  7679.     lda    #fncrea        ; Open for input
  7680.     jsr    openf        ; Open the file.  Closes rs
  7681.     jsr    logsnd        ; tell user what we're sending
  7682.     jsr    bufill        ; Go get characters from the file
  7683.     sta    size        ; Save the returned buffer size
  7684.     jsr    openrs        ; [jrd] now safe to use serial again
  7685.     lda    #'D        ; Set state to 'Send-data'
  7686.     sta    state        ;        ...
  7687.     lda    #true        ; Set up true return code
  7688.     rts            ;    and return
  7689.  
  7690. seof:    lda    numtry        ; Get the number of attempts for this packet
  7691.     inc    numtry        ; Now up it once for next time around
  7692.     cmp    maxtry        ; Are we over the allowed max?
  7693.     beq    seof1        ; Not quite yet
  7694.     bcs    seof1a        ; Yes, go abort
  7695. seof1:  jmp    seof1b        ; Continue sending packet
  7696. seof1a: lda    #'A        ; Load 'abort' code
  7697.     sta    state        ; Make that the state of the system
  7698.     lda    #errmrc        ; Fetch the error index
  7699.     sta    errcod        ;    and store it as the error code
  7700.     lda    #false        ; Return false
  7701.     rts            ;        ...
  7702. seof1b: lda    #'Z        ; Load the packet type 'Z' ('Send-eof')
  7703.     sta    ptype        ; Save that as a parm to Spak
  7704.     lda    n        ; Get the packet sequence number
  7705.     sta    pnum        ; Copy in that parm
  7706.     lda    #0        ; This is our packet data length (0 for EOF)
  7707.     sta    pdlen        ; Copy it
  7708.     jsr    spak        ; Go send out the Eof
  7709. seof2:  jsr    rpak        ; Try to receive an ack for it
  7710.     sta    rstat        ; Save the return status
  7711.     lda    ptype        ; Get the received packet type
  7712.     cmp    #'N        ; Was it a nak?
  7713.     bne    seof2a        ; If not, try the next packet type
  7714.     jmp    seofcn        ; Go take care of case nak
  7715. seof2a: cmp    #'Y        ; Was it an ack
  7716.     bne    seof2b        ; If it wasn't that, try return status
  7717.     jmp    seofca        ; Take care of the ack
  7718. seof2b: lda    rstat        ; Fetch the return status
  7719.     cmp    #false        ; Was it a failure?
  7720.     beq    seof2c        ; Yes, just fail return with current state
  7721.     jsr    prcerp        ; Check for error packet and process it
  7722.     lda    #'A        ; No, abort the whole thing
  7723.     sta    state        ; Set the state to that
  7724.     lda    #false        ; Get false return status
  7725. seof2c: rts            ; Return
  7726. seofcn: dec    pnum        ; Decrement the received packet sequence number
  7727.     lda    n        ; Get the expected sequence number
  7728.     cmp    pnum        ; If it's the same as pnum-1, it is like an ack
  7729.     bne    seofn1        ; It isn't, continue handling the nak
  7730.     jmp    seofa2        ; Switch to an ack but bypass sequence check
  7731. seofa1:
  7732. seofn1: lda    #false        ; Load failure return status
  7733.     rts            ;    and return
  7734. seofca: lda    n        ; Check sequence number expected against
  7735.     cmp    pnum        ;    the number we got.
  7736.     bne    seofa1        ; If not identical, fail and return curr. state
  7737. seofa2: lda    #0        ; Clear the number of tries for current packet
  7738.     sta    numtry        ;        ...
  7739.     jsr    incn        ; Up the packet sequence number
  7740.     jsr    getnfl        ; Call the routine to get the next file
  7741.     cmp    #eof        ; If it didn't find any more
  7742.     beq    seofrb        ;    then return state 'B' ('Send-Eot')
  7743.     jmp    seofrf        ; Otherwise, return 'F' ('Send-file')
  7744. seofrb: lda    #'B        ; Load Eot state code
  7745.     sta    state        ; Store that as the current state
  7746.     lda    #true        ; Give a success on the return
  7747.     rts            ;        ...
  7748. seofrf: lda    #'F        ; Load File-header state code
  7749.     sta    state        ; Make that the current system state
  7750.     lda    #true        ; Make success the return status
  7751.     rts            ;    and return
  7752.  
  7753. sini:    lda    #pdbuf\        ; Load the pointer to the
  7754.     sta    kerbf1        ;    packet buffer into its
  7755.     lda    #pdbuf^        ;    place on page zero
  7756.     sta    kerbf1+1    ;        ...
  7757.     jsr    spar        ; Go fill in the send init parms
  7758.     lda    numtry        ; If numtry > maxtry
  7759.     cmp    maxtry        ;        ...
  7760.     beq    sini1        ;        ...
  7761.     bcs    sini1a        ;    then we are in bad shape, go fail
  7762. sini1:  jmp    sini1b        ; Otherwise, we just continue
  7763. sini1a:    lda    #'A        ; Set state to 'abort'
  7764.     sta    state        ;        ...
  7765.     lda    #errmrc        ; Fetch the error index
  7766.     sta    errcod        ;    and store it as the error code
  7767.     lda    #0        ; Set return status (AC) to fail
  7768.     rts            ; Return
  7769. sini1b: inc    numtry        ; Increment the number of tries for this packet
  7770.     lda    #'S        ; Packet type is 'Send-init'
  7771.     sta    ptype        ; Store that
  7772. ;    lda    ebqmod        ; Do we want 8-bit quoting?
  7773. ;    cmp    #on        ;        ...
  7774. ;    beq    sini1c        ; If so, data length is 7
  7775. ;    lda    #$06        ; Else it is 6
  7776. ;    jmp    sini1d        ;        ...
  7777. sini1c: lda    #7        ; The length of data in a send-init is always 7
  7778. sini1d: sta    pdlen        ; Store that parameter
  7779.     lda    n        ; Get the packet number
  7780.     sta    pnum        ; Store that in its common area
  7781.     jsr    flshin        ;[25] Flush input buffer
  7782.     jsr    spak        ; Call the routine to ship the packet out
  7783.     jsr    rpak        ; Now go try to receive a packet
  7784.     sta    rstat        ; Hold the return status from that last routine
  7785. sinics: lda    ptype        ; Case statement, get the packet type
  7786.     cmp    #'Y        ; Was it an ACK?
  7787.     bne    sinic1        ; If not, try next type
  7788.     jmp    sinicy        ; Go handle the ack
  7789. sinic1: cmp    #'N        ; Was it a NAK?
  7790.     bne    sinic2        ; If not, try next condition
  7791.     jmp    sinicn        ; Handle a nak
  7792. sinic2: lda    rstat        ; Fetch the return status
  7793.     cmp    #false        ; Was this, perhaps false?
  7794.     bne    sinic3        ; Nope, do the 'otherwise' stuff
  7795.     jmp    sinicf        ; Just go and return
  7796. sinic3:    jsr    prcerp        ; Check for error packet and process it
  7797.     lda    #'A        ; Set state to 'abort'
  7798.     sta    state        ;        ...
  7799. sinicn:
  7800. sinicf: rts            ; Return
  7801.  
  7802. sinicy: ldy    #0        ; Clear Y
  7803.     lda    n        ; Get packet number
  7804.     cmp    pnum        ; Was the ack for that packet number?
  7805.     beq    siniy1        ; Yes, continue
  7806.     lda    #false        ; No, set false return status
  7807.     rts            ;    and go back
  7808. siniy1: jsr    rpar        ; Get parms from the ack packet
  7809.     lda    sebq        ; Check if other Kermit agrees to 8-bit quoting
  7810. ;    cmp    #'Y        ;        ...
  7811. ;    beq    siniy2        ; Yes!
  7812. ;    lda    #off        ; Shut it off
  7813. ;    sta    ebqmod        ;        ...
  7814.     cmp    #'N        ;[30]
  7815.     bne    siniy3        ;[30] Yes! Leave it alone
  7816.     lda    #off        ;[30] No .. Shut it off
  7817.     sta    ebqmod        ;[30]        ...
  7818. siniy2:
  7819. siniy3: lda    #'F        ; Load code for 'Send-file' into AC
  7820.     sta    state        ; Make that the new state
  7821.     lda    #0        ; Clear AC
  7822.     sta    numtry        ; Reset numtry to 0 for next send
  7823.     jsr    incn        ; Up the packet sequence number
  7824.     lda    #true        ; Return true
  7825.     rts
  7826.  
  7827. sbrk:    lda    numtry        ; Get the number of tries for this packet
  7828.     inc    numtry        ; Incrment it for next time
  7829.     cmp    maxtry        ; Have we exceeded the maximum
  7830.     beq    sbrk1        ; Not yet
  7831.     bcs    sbrk1a        ; Yes, go abort the whole thing
  7832. sbrk1:  jmp    sbrk1b        ; Continue send
  7833. sbrk1a:    lda    #'A        ; Load 'abort' code
  7834.     sta    state        ; Make that the system state
  7835.     lda    #errmrc        ; Fetch the error index
  7836.     sta    errcod        ;    and store it as the error code
  7837.     lda    #false        ; Load the failure return status
  7838.     rts            ;    and return
  7839. sbrk1b: lda    #'B        ; We are sending an Eot packet
  7840.     sta    ptype        ; Store that as the packet type
  7841.     lda    n        ; Get the current sequence number
  7842.     sta    pnum        ; Copy in that parameter
  7843.     lda    #0        ; The packet data length will be 0
  7844.     sta    pdlen        ; Copy that in
  7845.     jsr    spak        ; Go send the packet
  7846. sbrk2:  jsr    rpak        ; Try to get an ack
  7847.     sta    rstat        ; First, save the return status
  7848.     lda    ptype        ; Get the packet type received
  7849.     cmp    #'N        ; Was it a NAK?
  7850.     bne    sbrk2a        ; If not, try for the ack
  7851.     jmp    sbrkcn        ; Go handle the nak case
  7852. sbrk2a: cmp    #'Y        ; An ACK?
  7853.     bne    sbrk2b        ; If not, look at the return status
  7854.     jmp    sbrkca        ; Go handle the case of an ack
  7855. sbrk2b: lda    rstat        ; Fetch the return status from Rpak
  7856.     cmp    #false        ; Was it a failure?
  7857.     beq    sbrk2c        ; Yes, just return with current state
  7858.     jsr    prcerp        ; Check for error packet and process it
  7859.     lda    #'A        ; No, set up the 'abort' code
  7860.     sta    state        ;    as the system state
  7861.     lda    #false        ;    load the false return status
  7862. sbrk2c: rts            ;    and return
  7863. sbrkcn: dec    pnum        ; Decrement the received packet number once
  7864.     lda    n        ; Get the expected sequence number
  7865.     cmp    pnum        ; If =pnum-1 then this nak is like an ack
  7866.     bne    sbrkn1        ; No, this was no the case
  7867.     jmp    sbrka2        ; Yes! Go do the ack, but skip sequence check
  7868. sbrka1:
  7869. sbrkn1: lda    #false        ; Load failure return code
  7870.     rts            ;    and go back
  7871. sbrkca: lda    n        ; Get the expected packet sequence number
  7872.     cmp    pnum        ; Did we get what we expected?
  7873.     bne    sbrka1        ; No, return failure with current state
  7874. sbrka2: lda    #0        ; Yes, clear number of tries for this packet
  7875.     sta    numtry        ;        ...
  7876.     jsr    incn        ; Up the packet sequence number
  7877.     lda    #'C        ; The transfer is now complete, reflect this
  7878.     sta    state        ;    in the system state
  7879.     lda    #true        ; Return success!
  7880.     rts
  7881.  
  7882. .SBTTL    Setcom routine
  7883.  
  7884. ;
  7885. ;    This routine sets Kermit-65 parameters.
  7886. ;
  7887. ;        Input:  Parameters from command line
  7888. ;
  7889. ;        Output: NONE
  7890. ;
  7891. ;        Registers destroyed:    A,X,Y
  7892. ;
  7893.  
  7894. setcom: lda    #setcmd\    ; Load the address of the keyword table
  7895.     sta    cminf1        ;
  7896.     lda    #setcmd^    ;
  7897.     sta    cminf1+1    ;
  7898.     ldy    #0        ; No special flags needed
  7899.     lda    #cmkey        ; Comnd code for parse keyword
  7900.     jsr    comnd        ; Go get it
  7901.      jmp    kermt2        ; Give an error
  7902. ;---
  7903. ;    lda    #setcmb\    ; Get the address of jump table
  7904. ;    sta    jtaddr        ;
  7905. ;    lda    #setcmb^    ;
  7906. ;    sta    jtaddr+1    ;
  7907. ;    txa            ; Offset to AC
  7908. ;    jmp    jmpind        ;[DD] Jump
  7909. ;---
  7910.     stx    jtaddr        ; x,y has vector
  7911.     sty    jtaddr+1    ; set it
  7912.     jmp    (jtaddr)    ; and go there
  7913. ;
  7914. ;setcmb: jmp    stesc        ; Set escape character
  7915. ;    jmp    stibm        ; Set ibm-mode switch
  7916. ;    jmp    stle        ; Set local-echo switch
  7917. ;    jmp    strc        ; Set receive parameters
  7918. ;    jmp    stsn        ; Set send parameters
  7919. ;    jmp    stvt        ; Set vt52-emulation switch
  7920. ;    jmp    stfw        ; Set file-warning switch
  7921. ;    jmp    steb        ; Set Eight-bit quoting character
  7922. ;    jmp    stdb        ; Set debugging switch
  7923. ;    jmp    stmod        ; Set file-type mode
  7924. ;    jmp    stfbs        ; Set the file-byte-size for transfer
  7925. ;    jmp    stccr        ;[DD] Set rs232 registers 
  7926. ;    jmp    stpari        ; Set the parity for communication
  7927. ;    jmp    stbaud        ;[17] Set the baud rate for communication
  7928. ;    jmp    stwrd        ;[17] Set the word length for communication
  7929. ;    jmp    stflow        ;[24] Set flow control for communication
  7930. ;    jmp    stscre        ;[37] Set the screen size
  7931. ;    jmp    stdef        ; [jrd] set default disk
  7932.  
  7933. stesc:  ldx    #$10        ; Base should be hex
  7934.     ldy    #0        ; No special flags needed
  7935.     lda    #cmnum        ; Parse for integer
  7936.     jsr    comnd        ; Go!
  7937.      jmp    kermt4        ; Number is bad
  7938.     stx    ksavex        ; Hold the number across the next call
  7939.     sty    ksavey        ;        ...
  7940.     lda    #cmcfm        ; Parse for confirm
  7941.     jsr    comnd        ; Do it
  7942.      jmp    kermt3        ; Not confirmed
  7943.     lda    ksavey        ; If this isn't zero
  7944.     cmp    #0        ;    it's not an ASCII character
  7945.     beq    stesc1        ; It is, continue
  7946.     jmp    kermt4        ; Bad number, tell them
  7947. stesc1:    lda    ksavex        ; Get L.O. byte
  7948.     cmp    #$7F        ; It shouldn't be bigger than this
  7949.     bmi    stesc2        ; If it's less, it is ok
  7950.     jmp    kermt4        ; Tell the user it is bad
  7951. stesc2: sta    escp        ; Stuff it
  7952.     jmp    kermit
  7953.  
  7954. stibm:  jsr    prson        ; Try parsing an 'on' or 'off'
  7955.      jmp    kermt2        ; Bad keyword
  7956.     stx    ibmmod        ; Store value in the mode switch location
  7957.     stx    lecho        ; Also set local echo accordingly
  7958.     ldy    #nparit        ; Get ready to set the parity parameter
  7959.     lda    #fbebit        ;[17] Get ready to set the word-size parameter
  7960.     cpx    #on        ; Setting ibm mode on?
  7961.     bne    stibm1        ; Nope so set parity none/word-size eight-bit
  7962.     ldy    #mparit        ; Set mark parity
  7963.     lda    #fbsbit        ;[17] Set up for seven bit word size
  7964.     ldx    #off        ;[38] Turn off flow-control
  7965.     stx    flowmo        ;[38]        ...
  7966. stibm1:    sty    parity        ; Store the value
  7967.     sta    wrdsiz        ;[17]        ...
  7968.     lda    #cmcfm        ;[17] Parse for confirm
  7969.     jsr    comnd        ;[17] Do it
  7970.      jmp    kermt3        ;[17] Not confirmed, tell the user that
  7971.     jsr    dopari        ;[17] Really set the parity
  7972.     jsr    dowrd        ;[17] Really set the word size
  7973.     jmp    kermit        ;
  7974.  
  7975. stle:    jsr    prson        ; Try parsing an 'on' or 'off'
  7976.      jmp    kermt2        ; Bad keyword
  7977.     stx    lecho        ; Store value in the mode switch location
  7978.     lda    #cmcfm        ; Parse for confirm
  7979.     jsr    comnd        ; Do it
  7980.      jmp    kermt3        ; Not confirmed, tell the user that
  7981.     jmp    kermit
  7982.  
  7983. strc:    lda    #0        ; Set srind for receive parms
  7984.     sta    srind        ;        ...
  7985.     lda    #stscmd\    ; Load the address of the keyword table
  7986.     sta    cminf1        ; Save it for the keyword routine
  7987.     lda    #stscmd^    ;
  7988.     sta    cminf1+1    ;
  7989.     ldy    #0        ; No special flags needed
  7990.     lda    #cmkey        ; Comnd code for parse keyword
  7991.     jsr    comnd        ; Go get it
  7992.      jmp    kermt2        ; Give an error
  7993.     lda    #stcct\        ; Get addr. of jump table
  7994.     sta    jtaddr        ;
  7995.     lda    #stcct^        ;        ...
  7996.     sta    jtaddr+1    ;        ...
  7997.     txa            ; Offset to AC
  7998.     jmp    jmpind      ;[DD] Jump
  7999.  
  8000. stsn:    lda    #1        ; Set srind for send parms
  8001.     sta    srind        ;        ...
  8002.     lda    #stscmd\    ; Load the address of the keyword table
  8003.     sta    cminf1        ; Save it for the keyword routine
  8004.     lda    #stscmd^    ;        ...
  8005.     sta    cminf1+1    ;        ...
  8006.     ldy    #0        ; No special flags needed
  8007.     lda    #cmkey        ; Comnd code for parse keyword
  8008.     jsr    comnd        ; Go get it
  8009.      jmp    kermt2        ; Give an error
  8010.     lda    #stcct\        ; Get addr. of jump table
  8011.     sta    jtaddr        ;
  8012.     lda    #stcct^        ;
  8013.     sta    jtaddr+1    ;
  8014.     txa            ; offset to AC
  8015.     jmp    jmpind        ;[DD] Jump
  8016.  
  8017. stcct:  jmp    stpdc        ; Set send/rec padding character
  8018.     jmp    stpad        ; Set amount of padding on send/rec
  8019.     jmp    stebq        ; Set send/rec eight-bit-quoting character    
  8020.     jmp    steol        ; Set send/rec end-of-line
  8021.     jmp    stpl        ; Set send/rec packet length
  8022.     jmp    stqc        ; Set send/rec quote character
  8023.     jmp    sttim        ; Set send/rec timeout
  8024.  
  8025. stvt:    lda    #termemu\    ; parse for terminal emulation type
  8026.     sta    cminf1
  8027.     lda    #termemu^
  8028.     sta    cminf1+1
  8029.     ldy    #0        ; no special flags needed
  8030.     lda    #cmkey        ; parse for a keyword
  8031.     jsr    comnd        ; do it
  8032.      jmp    kermt2        ; go tell the user about the error
  8033.     stx    vtmod        ; Store value in the mode switch location
  8034.     lda    #cmcfm        ; Parse for confirm
  8035.     jsr    comnd        ; Do it
  8036.      jmp    kermt3        ; Not confirmed, tell the user that
  8037.     jmp    kermit
  8038.  
  8039. stfw:    jsr    prson        ; Try parsing an 'on' or 'off'
  8040.      jmp    kermt2        ; Bad keyword
  8041.     stx    filwar        ; Store value in the mode switch location
  8042.     lda    #cmcfm        ; Parse for confirm
  8043.     jsr    comnd        ; Do it
  8044.      jmp    kermt3        ; Not confirmed, tell the user that
  8045.     jmp    kermit
  8046.  
  8047. steb:    jsr    prson        ; Try parsing an 'on' or 'off'
  8048.      jmp    kermt2        ; Bad keyword
  8049.     stx    ebqmod        ; Store value in the mode switch location
  8050.     lda    #cmcfm        ; Parse for confirm
  8051.     jsr    comnd        ; Do it
  8052.      jmp    kermt3        ; Not confirmed, tell the user that
  8053.     jmp    kermit
  8054.  
  8055. stdb:    ldx    #debkey\    ;  Load the address of the keyword table
  8056.     ldy    #debkey^
  8057.     stx    cminf1        ;  Save it for the keyword routine
  8058.     sty    cminf1+1
  8059.     ldy    #0        ; No special flags needed
  8060.     lda    #cmkey        ; Comnd code for parse keyword
  8061.     jsr    comnd        ; Go get it
  8062.      jmp    kermt2        ; Give an error
  8063.     stx    debug        ; Stuff returned value into debug switch
  8064.     lda    #cmcfm        ; Parse for a confirm
  8065.     jsr    comnd        ; Do it
  8066.      jmp    kermt3        ; Not confirmed, tell the user that
  8067.     jmp    kermit
  8068.  
  8069.  
  8070. stebq:  ldx    #$10        ; Base for ASCII value
  8071.     ldy    #0        ; No special flags needed
  8072.     lda    #cmnum        ; Code for integer number
  8073.     jsr    comnd        ; Go do it
  8074.      jmp    kermt4        ; The number was bad
  8075.     tya            ; If this isn't zero
  8076.     cmp    #0        ;    it's not an ASCII character
  8077.     beq    steb1        ; It is, continue
  8078.     jmp    kermt4        ; Bad number, tell them
  8079. steb1:    txa            ; Get L.O. byte
  8080.     cmp    #$7F        ; It shouldn't be bigger than this
  8081.     bmi    steb2        ; If it's less, it is ok
  8082.     jmp    kermt4        ; Tell the user it is bad
  8083. steb2:  cmp    #$21        ; First check the character range
  8084.     bmi    steb4        ; Not in range
  8085.     cmp    #$3f        ;        ...
  8086.     bmi    steb3        ; Inrange
  8087.     cmp    #$60        ;        ...
  8088.     bmi    steb4        ; Not in range
  8089. steb3:  ldx    srind        ; Get index for receive or send parms
  8090.     sta    ebq,x        ; Stuff it
  8091.     lda    #cmcfm        ; Parse for confirm
  8092.     jsr    comnd        ; Do it
  8093.      jmp    kermt3        ; Not confirmed, tell the user that
  8094.     jmp    kermit        ;
  8095. steb4:  ldx    #ermes5\    ; Get error message
  8096.     ldy    #ermes5^    ;        ...
  8097.     jsr    prstr        ; Print the error
  8098.     jsr    prcfm        ; Go parse and print a confirm
  8099.     jmp    kermit        ; Go back
  8100.  
  8101. steol:  ldx    #$10        ; Base for ASCII value
  8102.     ldy    #0        ; No special flags needed
  8103.     lda    #cmnum        ; Code for integer number
  8104.     jsr    comnd        ; Go do it
  8105.      jmp    kermt4        ; The number was bad
  8106.     tya            ; If this isn't zero
  8107.     cmp    #0        ;    it's not an ASCII character
  8108.     beq    steo1        ; It is, continue
  8109.     jmp    kermt4        ; Bad number, tell them
  8110. steo1:    txa            ; Get L.O. byte
  8111.     cmp    #$7F        ; It shouldn't be bigger than this
  8112.     bmi    steo2        ; If it's less, it is ok
  8113.     jmp    kermt4        ; Tell the user it is bad
  8114. steo2:  ldx    srind        ; Fetch index for receive or send parms
  8115.     sta    eol,x        ; Stuff it
  8116.     jsr    prcfm        ; Go parse and print a confirm
  8117.     jmp    kermit        ; Go back
  8118.  
  8119. stpad:
  8120. ;    ldx    #$10        ; Base for ASCII value
  8121.     ldx    #10        ; decimal, please
  8122.     ldy    #0        ; No special flags needed
  8123.     lda    #cmnum        ; Code for integer number
  8124.     jsr    comnd        ; Go do it
  8125.      jmp    kermt4        ; The number was bad
  8126.     tya            ; If this isn't zero
  8127.     cmp    #0        ;    it's not an ASCII character
  8128.     beq    stpd1        ; It is, continue
  8129.     jmp    kermt4        ; Bad number, tell them
  8130. stpd1:    txa            ; Get L.O. byte
  8131.     cmp    #$7F        ; It shouldn't be bigger than this
  8132.     bmi    stpd2        ; If it's less, it is ok
  8133.     jmp    kermt4        ; Tell the user it is bad
  8134. stpd2:  ldx    srind        ; Get index (receive or send)
  8135.     sta    pad,x        ; Stuff it
  8136.     jsr    prcfm        ; Go parse and print a confirm
  8137.     jmp    kermit        ; Go back
  8138.  
  8139. stpdc:  ldx    #$10        ; Base for ASCII value
  8140.     ldy    #0        ; No special flags needed
  8141.     lda    #cmnum        ; Code for integer number
  8142.     jsr    comnd        ; Go do it
  8143.      jmp    kermt4        ; The number was bad
  8144.     tya            ; If this isn't zero
  8145.     cmp    #0        ;    it's not an ASCII character
  8146.     beq    stpc1        ; It is, continue
  8147.     jmp    kermt4        ; Bad number, tell them
  8148. stpc1:    txa            ; Get L.O. byte
  8149.     cmp    #$7F        ; It shouldn't be bigger than this
  8150.     bmi    stpc2        ; If it's less, it is ok
  8151.     jmp    kermt4        ; Tell the user it is bad
  8152. stpc2:  ldx    srind        ; Get index for parms
  8153.     sta    padch,x        ; Stuff it
  8154.     jsr    prcfm        ; Go parse and print a confirm
  8155.     jmp    kermit        ; Go back
  8156.  
  8157. stpl:
  8158. ;    ldx    #$10        ; Base for ASCII value
  8159.     ldx    #10        ; decimal, please
  8160.     ldy    #0        ; No special flags needed
  8161.     lda    #cmnum        ; Code for integer number
  8162.     jsr    comnd        ; Go do it
  8163.      jmp    kermt4        ; The number was bad
  8164.     tya            ; If this isn't zero
  8165.     cmp    #0        ;    it's not an ASCII character
  8166.     beq    stpl1        ; It is, continue
  8167.     jmp    kermt4        ; Bad number, tell them
  8168. stpl1:    txa            ; Get L.O. byte
  8169.     cmp    #mxpack        ; It shouldn't be bigger than this
  8170.     bmi    stpl2        ; If it's less, it is ok
  8171.     jmp    kermt4        ; Tell the user it is bad
  8172. stpl2:  ldx    srind        ; Get index
  8173.     sta    psiz,x        ; Stuff it
  8174.     jsr    prcfm        ; Go parse and print a confirm
  8175.     jmp    kermit        ; Go back
  8176.  
  8177. stqc:    ldx    #$10        ; Base for ASCII value
  8178.     ldy    #0        ; No special flags needed
  8179.     lda    #cmnum        ; Code for integer number
  8180.     jsr    comnd        ; Go do it
  8181.      jmp    kermt4        ; The number was bad
  8182.     tya            ; If this isn't zero
  8183.     cmp    #0        ;    it's not an ASCII character
  8184.     beq    stqc1        ; It is, continue
  8185.     jmp    kermt4        ; Bad number, tell them
  8186. stqc1:    txa            ; Get L.O. byte
  8187.     cmp    #$7F        ; It shouldn't be bigger than this
  8188.     bmi    stqc2        ; If it's less, it is ok
  8189.     jmp    kermt4        ; Tell the user it is bad
  8190. stqc2:  ldx    srind        ; Fetch index for receive or send parms
  8191.     sta    quote,x        ; Stuff it
  8192.     jsr    prcfm        ; Go parse and print a confirm
  8193.     jmp    kermit        ; Go back
  8194.  
  8195. sttim:
  8196. ;    ldx    #$10        ; Base for ASCII value
  8197.     ldx    #10        ; decimal, please
  8198.     ldy    #0        ; No special flags needed
  8199.     lda    #cmnum        ; Code for integer number
  8200.     jsr    comnd        ; Go do it
  8201.      jmp    kermt4        ; The number was bad
  8202.     tya            ; If this isn't zero
  8203.     cmp    #0        ;    it's not an ASCII character
  8204.     beq    sttm1        ; It is, continue
  8205.     jmp    kermt4        ; Bad number, tell them
  8206. sttm1:    txa            ; Get L.O. byte
  8207.     cmp    #$7F        ; It shouldn't be bigger than this
  8208.     bmi    sttm2        ; If it's less, it is ok
  8209.     jmp    kermt4        ; Tell the user it is bad
  8210. sttm2:  ldx    srind        ; Fetch index for receive or send parms
  8211.     sta    time,x        ; Stuff it
  8212.     jsr    prcfm        ; Go parse and print a confirm
  8213.     jmp    kermit        ; Go back
  8214.  
  8215. stmod:    lda    #ftcmd\        ; Load the address of the keyword table
  8216.     sta    cminf1        ;
  8217.     lda    #ftcmd^        ;
  8218.     sta    cminf1+1    ;
  8219.     lda    #ftcdef\    ; Load default address
  8220.     sta    cmdptr        ;        ...
  8221.     lda    #ftcdef^    ;        ...
  8222.     sta    cmdptr+1    ;        ...
  8223.     ldy    #cmfdff        ; Tell Comnd there is a default
  8224.     lda    #cmkey        ; Comnd code for parse keyword
  8225.     jsr    comnd        ; Go get it
  8226.      jmp    kermt2        ; Give an error
  8227.     stx    filmod        ; Save the file-type mode
  8228.     lda    #cmcfm        ; Parse for a confirm
  8229.     jsr    comnd        ; Do it
  8230.      jmp    kermt3        ; Not confirmed, tell the user that
  8231.     jmp    kermit
  8232.  
  8233. ;stfbs:    lda    #fbskey\    ; Load the address of the keyword table
  8234. ;    sta    cminf1        ;
  8235. ;    lda    #fbskey^    ;
  8236. ;    sta    cminf1+1    ;
  8237. ;    ldy    #0        ; No special flags needed
  8238. ;    lda    #cmkey        ; Comnd code for parse keyword
  8239. ;    jsr    comnd        ; Go get it
  8240. ;     jmp    kermt2        ; Give an error
  8241. ;    stx    fbsize        ; Stuff the returned value into file-byte-size
  8242. ;    lda    #cmcfm        ; Parse for a confirm
  8243. ;    jsr    comnd        ; Do it
  8244. ;     jmp    kermt3        ; Not confirmed, tell the user that
  8245. ;    jmp    kermit
  8246.  
  8247.  
  8248. stccr:  ldx    #$10        ;[DD] Base should be hex
  8249.     ldy    #0        ; No special flags needed
  8250.     lda    #cmnum        ;[DD] Parse for integer
  8251.     jsr    comnd        ;[DD] Go do it
  8252.      jmp    kermt4        ;[DD] The number was bad
  8253. stccr1:    stx    ksavex        ; Store it while we confirm
  8254.     sty    ksavey        ;        ...
  8255.     lda    #cmcfm        ; Set up to parse confirm
  8256.     jsr    comnd        ; Do it
  8257.      jmp    kermt3        ; Wasn't properly confirmed
  8258.     lda    ksavex        ; Fetch back L.O. byte
  8259.     sta    x36ax1        ;[DD][EL] To rs232 reg 0
  8260.     lda    ksavey        ;[18] Fetch back H.O. byte
  8261.     sta    x38ax1        ;[DD] To rs232 reg 1
  8262.     jmp    kermit        ;[DD] 
  8263.  
  8264. stpari:    lda    #parkey\    ; Load the address of the keyword table
  8265.     sta    cminf1        ; Save it for the keyword routine
  8266.     lda    #parkey^    ;        ...
  8267.     sta    cminf1+1    ;        ...
  8268.     ldy    #0        ; No special flags needed
  8269.     lda    #cmkey        ; Comnd code for parse keyword
  8270.     jsr    comnd        ; Go get it
  8271.      jmp    kermt2        ; Give an error
  8272.     stx    parity        ; Stuff returned value into parity
  8273.     lda    #cmcfm        ; Parse for a confirm
  8274.     jsr    comnd        ; Do it
  8275.      jmp    kermt3        ; Not confirmed, tell the user that
  8276.     jsr    dopari        ;[17] Now really set the parity
  8277.     jmp    kermit        ;
  8278.  
  8279. dopari:    lda    x38ax1        ;[17] Get the command register
  8280.     and    #$C0        ;[17] mask out in+out parity
  8281.     sta    x38ax1        ;[17] Store it back
  8282.     ldx    parity        ;[17] Get the index
  8283.     lda    parval,x    ;[17]    and the parity value from the table
  8284.     ora    x38ax1        ;[17]
  8285.     sta    x38ax1        ;[17] Store it back
  8286.     rts            ;[17] Return
  8287.  
  8288. stbaud:    lda    #bdkey\        ;[17] Load the address of the keyword table
  8289.     sta    cminf1        ;[17] Save it for the keyword routine
  8290.     lda    #bdkey^        ;[17]        ...
  8291.     sta    cminf1+1    ;[17]        ...
  8292.     ldy    #0        ;[17] No special flags needed
  8293.     lda    #cmkey        ;[17] Parse for a keyword
  8294.     jsr    comnd        ;[17] Do it
  8295.      jmp    kermt2        ;[17] Give an error
  8296.     stx    baud        ;[17] Stuff the returned value
  8297.     lda    #cmcfm        ;[17] Set up for a confirm
  8298.     jsr    comnd        ;[17] Do it
  8299.      jmp    kermt3        ;[17] Not confirmed
  8300.     jsr    dobad        ;[17] Really set the baud rate
  8301.     jmp    kermit        ;[17] 
  8302.  
  8303. dobad:    lda    x36ax1        ;[17] Get the control register
  8304.     and    #$F0        ;[17] Clear it
  8305.     sta    x36ax1        ;[17] Store it back
  8306.     ldx    baud        ;[17] Get the baud rate back
  8307.     lda    bdval,x        ;[17] Get the value from the table
  8308.     ora    x36ax1        ;[17] Set the baud rate
  8309.     sta    x36ax1        ;[17]  and store it
  8310.     rts            ;[17]
  8311.  
  8312. stwrd:    lda    #fbskey\    ;[17] Load the address of the keyword table
  8313.     sta    cminf1        ;[17] Save it for the keyword routine
  8314.     lda    #fbskey^    ;[17]        ...
  8315.     sta    cminf1+1    ;[17]        ...
  8316.     ldy    #0        ;[17] No special flags needed
  8317.     lda    #cmkey        ;[17] Comnd code for parse keyword
  8318.     jsr    comnd        ;[17] Go get it
  8319.      jmp    kermt2        ;[17] Give an error
  8320.     stx    wrdsiz        ;[17] Stuff the returned value into wrd len
  8321.     lda    #cmcfm        ;[17] Parse for a confirm
  8322.     jsr    comnd        ;[17] Do it
  8323.      jmp    kermt3        ;[17] Not confirmed, tell the user that
  8324.     jsr    dowrd        ;[17] Really set the word size
  8325.     jmp    kermit        ;[17]        ...
  8326.  
  8327. dowrd:    lda    x36ax1        ;[17] Get the control register
  8328.     and    #$8F        ;[17] mask for word size
  8329.     sta    x36ax1        ;[17] Store it back
  8330.     lda    wrdsiz        ;[17] Get the word size
  8331.     cmp    #fbsbit        ;[17] Is it seven-bit ?
  8332.     bne    dwrd1        ;[17] No, we have the value for eight-bit
  8333.                 ; NB, this depends on fbebit = 0
  8334.     lda    #$10        ;[17] Yes, get value for seven-bit word size
  8335. dwrd1:    ora    x36ax1        ;[17] Set it
  8336.     sta    x36ax1        ;[17] Store it
  8337.     rts            ;[17] Return
  8338.  
  8339. stflow: jsr    prson        ;[24] Try parsing an 'on' or 'off'
  8340.      jmp    kermt2        ;[24] Bad keyword
  8341.     stx    flowmo        ;[24] Store it
  8342.     lda    #cmcfm        ;[24] Parse for confirm
  8343.     jsr    comnd        ;[24] Do it
  8344.      jmp    kermt3        ;[24] Not confirmed, tell the user that
  8345.     jmp    kermit        ;[24]
  8346.  
  8347. stscre:    lda    #scrkey\    ;[37] Get the address of the screen mode table
  8348.     sta    cminf1        ;[37]        ...
  8349.     lda    #scrkey^    ;[37]        ...
  8350.     sta    cminf1+1    ;[37]        ...
  8351.     ldy    #0        ;[37] No special flags needed
  8352.     lda    #cmkey        ;[37] Comnd code for parse keyword
  8353.     jsr    comnd        ;[37] Go get it
  8354.      jmp    kermt2        ;[37] Give an error
  8355.     stx    kwrk01        ;[37] Stuff the returned value into kwrk01
  8356.     lda    #cmcfm        ;[37] Parse for a confirm
  8357.     jsr    comnd        ;[37] Do it
  8358.      jmp    kermt3        ;[37] Not confirmed, tell the user that
  8359.     lda    kwrk01        ;[37] Are we switching to 80 columns?
  8360. ;
  8361. ;get:
  8362. ;    pha            ; save the id of the screen driver we want
  8363. ;    jsr    scrext        ; exit the old screen driver
  8364. ;    pla
  8365. ; [jrd] no need to test, they're all here
  8366. ;    pha            ; keep the id of the screen driver on the stack
  8367. ;    jsr    scrtst        ; does this screen driver exist?
  8368. ;    pla            ; restore desired screen type
  8369. ;    bcc    get1
  8370. ;    lda    #1        ; if it does not exist, use 80-columns instead
  8371. ;get1:
  8372.     sta    conscrt        ; [jrd] use the slot that connect code uses
  8373. ;    jsr    scrent        ; enter the screen driver
  8374.     jmp    kermit        ; all done
  8375.  
  8376. ;
  8377. ; Set default disk
  8378. ;
  8379. stdef:  ldx    #$10        ; Base should be hex
  8380.     ldy    #0        ; No special flags needed
  8381.     lda    #cmnum        ; Parse for integer
  8382.     jsr    comnd        ; Go!
  8383.      jmp    kermt4        ; Number is bad
  8384.     stx    ksavex        ; save it for a bit
  8385.     sty    ksavey
  8386.     lda    #cmcfm        ; Set up to parse confirm
  8387.     jsr    comnd        ; Do it
  8388.      jmp    kermt3        ; Wasn't properly confirmed
  8389.     lda    ksavex        ; value back in A
  8390.     beq    stdefng        ; zero's no good
  8391.     bmi    stdefng        ; neg either
  8392.     cmp    #9        ; [jrd v3.7] between 1 and 8?
  8393.     bcs    stdefng        ; nope, lose
  8394.     adc    #$30        ; make into ascii; carry's clear
  8395.     sta    dsknum        ; stuff into the relevant place
  8396.     jmp    kermit        ; done!
  8397. stdefng: jmp    kermt4        ; error return    
  8398.  
  8399. .SBTTL    Show routine
  8400.  
  8401. ;
  8402. ;    This routine shows any of the operational parameters that
  8403. ;    can be altered with the set command.
  8404. ;
  8405. ;        Input:  Parameters from command line
  8406. ;
  8407. ;        Output: Display parameter values on screen
  8408. ;
  8409. ;        Registers destroyed:    A,X,Y
  8410. ;
  8411.  
  8412. show:    lda    #shocmd\    ; Load address of keyword table
  8413.     sta    cminf1        ;
  8414.     lda    #shocmd^    ;
  8415.     sta    cminf1+1    ;
  8416.     lda    #shodef\    ; Fetch default address
  8417.     sta    cmdptr        ;        ...
  8418.     lda    #shodef^    ;        ...
  8419.     sta    cmdptr+1    ;        ...
  8420.     ldy    #cmfdff        ; Indicate that there is a default
  8421.     lda    #cmkey        ; Comnd code to parse keyword
  8422.     jsr    comnd        ; Go parse the keyword
  8423.      jmp    kermt2        ; Bad keyword, go give an error
  8424. ;---
  8425. ;    lda    #shocmb\     ; Get addr. of jump table
  8426. ;    sta    jtaddr        ;
  8427. ;    lda    #shocmb^    ;
  8428. ;    sta    jtaddr+1    ;
  8429. ;    txa            ; Offset to AC
  8430. ;    jmp    jmpind        ;[DD] Jump
  8431. ;---
  8432.     stx    jtaddr        ; x,y has vector
  8433.     sty    jtaddr+1    ; set it
  8434. ;
  8435. ;the routines here are set up to be jsr-ed to, so we'll do it that way
  8436. ;rather than just jumping.  We'll jsr, the routine'll return, and we'll
  8437. ;continue execution after our jsr
  8438. ;
  8439.     jsr    show1        ; jsr to the dispatcher
  8440.     jmp    kermit        ; done!
  8441.  
  8442. show1:    jmp    (jtaddr)    ; go there.  He'll return
  8443.                 ; to our caller.
  8444. ;
  8445. ;shocmb: jsr    prcfm        ; Parse for confirm
  8446. ;    jsr    shall        ; Show all setable parameters
  8447. ;    jmp    kermit        ; Go to top of main loop
  8448. ;    jsr    prcfm        ; Parse for confirm
  8449. ;    jsr    shesc        ; Show escape character
  8450. ;    jmp    kermit        ; Go to top of main loop
  8451. ;    jsr    prcfm        ; Parse for confirm
  8452. ;    jsr    shibm        ; Show ibm-mode switch
  8453. ;    jmp    kermit        ; Go to top of main loop
  8454. ;    jsr    prcfm        ; Parse for confirm
  8455. ;    jsr    shle        ; Show local-echo switch
  8456. ;    jmp    kermit        ; Go to top of main loop
  8457. ;    nop            ; We should not parse for confirm
  8458. ;    nop            ;    since this routine parses for
  8459. ;    nop            ;    a keyword next
  8460. ;    jsr    shrc        ; Show receive parameters
  8461. ;    jmp    kermit        ; Go to top of main loop
  8462. ;    nop            ; We should not parse for confirm
  8463. ;    nop            ;    since this routine parses for
  8464. ;    nop            ;    a keyword next
  8465. ;    jsr    shsn        ; Show send parameters
  8466. ;    jmp    kermit        ; Go to top of main loop
  8467. ;    jsr    prcfm        ; Parse for confirm
  8468. ;    jsr    shvt        ; Show vt52-emulation mode switch
  8469. ;    jmp    kermit        ; Go to top of main loop
  8470. ;    jsr    prcfm        ; Parse for confirm
  8471. ;    jsr    shfw        ; Show file-warning switch
  8472. ;    jmp    kermit        ; Go to top of main loop
  8473. ;    jsr    prcfm        ; Parse for confirm
  8474. ;    jsr    sheb        ; Show eight-bit-quoting switch
  8475. ;    jmp    kermit        ; Go to top of main loop
  8476. ;    jsr    prcfm        ; Parse for confirm
  8477. ;    jsr    shdb        ; Show debugging mode switch
  8478. ;    jmp    kermit        ; Go to top of main loop
  8479. ;    jsr    prcfm        ; Parse for confirm
  8480. ;    jsr    shmod        ; Show File mode
  8481. ;    jmp    kermit        ; Go to top of main loop
  8482. ;    jsr    prcfm        ; Parse for confirm
  8483. ;    jsr    shfbs        ; Show the file-byte-size
  8484. ;    jmp    kermit        ; Go to top of main loop
  8485. ;    jsr    prcfm        ;[DD] Parse for confirm 
  8486. ;    jsr    shccr        ;[DD] Show rs232 regs.
  8487. ;    jmp    kermit        ;[DD] Go to top of main loop
  8488. ;    jsr    prcfm        ; Parse for confirm
  8489. ;    jsr    shpari        ; Show Parity
  8490. ;    jmp    kermit        ; Go to top of main loop
  8491. ;    jsr    prcfm        ;[17] Parse for a confirm
  8492. ;    jsr    shbad        ;[17] Show baud
  8493. ;    jmp    kermit        ;[17] Go to top of main loop
  8494. ;    jsr    prcfm        ;[17] Parse for a confirm
  8495. ;    jsr    shwrd        ;[17] Show word size
  8496. ;    jmp    kermit        ;[17] Go to top of main loop
  8497. ;    jsr    prcfm        ;[24] Parse for a confirm
  8498. ;    jsr    shflow        ;[24] Show flow-control
  8499. ;    jmp    kermit        ;[24] Go to top of main loop
  8500. ;
  8501. ; sho def.  Surely there's a better way to do this?
  8502. ;
  8503. ;    jsr    prcfm        ;[24] Parse for a confirm
  8504. ;    jsr    shdef        ;[24] show def
  8505. ;    jmp    kermit        ;[24] Go to top of main loop
  8506.  
  8507. ;
  8508. ; this is sort of a kludge.  Many of the things this calls
  8509. ; need to be callable separately; in the latter case they 
  8510. ; want to get a confirm, in this case, they don't as it's
  8511. ; done once for all of them.  For those cases, we call the
  8512. ; regular entry point + 3, skipping the call to prcfm.  Sigh.
  8513. ;
  8514. shall:
  8515.     jsr    prcfm        ; make sure confirmed
  8516.     jsr    shdb+3        ; Show debugging mode switch
  8517.     jsr    shvt+3        ; Show vt52-emulation mode switch
  8518.     jsr    shibm+3        ; Show ibm-mode switch
  8519.     jsr    shle+3        ; Show local-echo switch
  8520.     jsr    shbad+3        ;[17] Show baud rate
  8521.     jsr    shpari+3        ; Show parity setting
  8522.     jsr    shwrd+3        ;[17] Show word length
  8523.     jsr    shflow+3        ;[24] Show flow-control
  8524.     jsr    sheb+3        ; Show eight-bit-quoting switch
  8525.     jsr    shfw+3        ; Show file-warning switch
  8526.     jsr    shesc+3        ; Show the current escape character
  8527.     jsr    shmod+3        ; Show the file-type mode
  8528. ;    jsr    shfbs+3        ; Show the file-byte-size
  8529.     jsr    shdef+3        ; [jrd] show default drive
  8530.     jsr    shccr+3        ;[DD] Show rs232 regs.
  8531. ;
  8532. ; these last two don't needed the +3; they're only used here
  8533. ;
  8534.     jsr    shrcal        ; Show receive parameters
  8535.     jsr    shsnal        ; Show send parameters
  8536.     rts            ; Return
  8537.  
  8538. shdb:    jsr    prcfm        ; make sure confirmed
  8539.     ldx    #shin00\    ; Get address of message for this item
  8540.     ldy    #shin00^
  8541.     jsr    prstr        ; Print that message
  8542.     lda    debug        ; Get the switch value
  8543.     cmp    #3        ; Is it >= 3?
  8544.     bmi    shdb1        ; If not just get the string and print it
  8545.     lda    #0        ; This is index for debug mode we want
  8546. shdb1:    tax            ; Hold this index
  8547.     lda    #kerdms\    ; Get the address of the debug strings
  8548.     sta    kermbs        ; And stuff it here for genmad
  8549.     lda    #kerdms^    ;        ...
  8550.     sta    kermbs+1    ;        ...
  8551.     lda    #kerdsz        ; Get the string length
  8552.     pha            ; Push that
  8553.     txa            ; Fetch the index back
  8554.     pha            ; Push that parm then
  8555.     jsr    genmad        ;    call genmad
  8556.     jsr    prstr        ; Print the the string at that address
  8557.     jsr    prcrlf        ; Print a crelf after it
  8558.     rts
  8559.  
  8560. shvt:    jsr    prcfm        ; make sure confirmed
  8561.     ldx    #shin01\    ; Get address of message for this item
  8562.     ldy    #shin01^
  8563.     jsr    prstr        ; Print that message
  8564.     lda    #kertms\    ; get address of messages for this item
  8565.     sta    kermbs
  8566.     lda    #kertms^
  8567.     sta    kermbs+1
  8568.     lda    #keremu        ; length of the messages
  8569.     pha
  8570.     lda    vtmod        ; which message
  8571.     pha
  8572.     jsr    genmad        ; calculate address of selected message
  8573.     jsr    prstr        ; print selected message
  8574.     jsr    prcrlf        ; and a carriage return / line feed
  8575.     rts            ; all done
  8576.  
  8577. shibm:    jsr    prcfm        ; make sure confirmed
  8578.     ldx    #shin02\    ; Get address of message for this item
  8579.     ldy    #shin02^
  8580.     jsr    prstr        ; Print that message
  8581.     lda    ibmmod        ; Get the switch value
  8582.     jmp    pron        ; Go print the 'on' or 'off' string
  8583.  
  8584. shle:    jsr    prcfm        ; make sure confirmed
  8585.     ldx    #shin03\    ; Get address of message for this item
  8586.     ldy    #shin03^
  8587.     jsr    prstr        ; Print that message
  8588.     lda    lecho        ; Get the switch value
  8589.     jmp    pron        ; Go print the 'on' or 'off' string
  8590.  
  8591. sheb:    jsr    prcfm        ; make sure confirmed
  8592.     ldx    #shin04\    ; Get address of message for this item
  8593.     ldy    #shin04^
  8594.     jsr    prstr        ; Print that message
  8595.     lda    ebqmod        ; Get the switch value
  8596.     jmp    pron        ; Go print the 'on' or 'off' string
  8597.  
  8598. shfw:    jsr    prcfm        ; make sure confirmed
  8599.     ldx    #shin05\    ; Get address of message for this item
  8600.     ldy    #shin05^
  8601.     jsr    prstr        ; Print that message
  8602.     lda    filwar        ; Get the switch value
  8603.     jmp    pron        ; Go print the 'on' or 'off' string
  8604.  
  8605. shesc:    jsr    prcfm        ; make sure confirmed
  8606.     ldx    #shin06\    ; Get address of message
  8607.     ldy    #shin06^
  8608.     jsr    prstr        ; Print message
  8609.     lda    escp        ; Get the escape character
  8610.     jsr    prchr        ; Print the special character
  8611.     jsr    prcrlf        ; Print a crelf
  8612.     rts            ;    and return
  8613.  
  8614. shccr:    jsr    prcfm        ; make sure confirmed
  8615.     ldx    #shin18\    ;[DD][EL] Print rs232 registers x36ax1,x38ax1 
  8616.     ldy    #shin18^    ;[DD]
  8617.     jsr    prstr        ;[DD]
  8618.     lda    x38ax1        ;[DD] Print rs232 reg 1
  8619.     jsr    prbyte        ;[DD]
  8620.     lda    x36ax1        ;[DD] Print rs232 reg 0
  8621.     jsr    prbyte        ;[DD]
  8622.     jsr    prcrlf        ;[DD]    and a crlf
  8623.     rts            ;[DD]
  8624.  
  8625.  
  8626. shsn:    lda    #1        ; Set up index to be used later
  8627.     sta    srind
  8628.     lda    #stscmd\    ; Get the set option table address
  8629.     sta    cminf1        ;
  8630.     lda    #stscmd^    ;
  8631.     sta    cminf1+1    ;
  8632.     ldy    #0        ; No special flags needed
  8633.     lda    #cmkey        ; Code for keyword parse
  8634.     jsr    comnd        ; Try to parse it
  8635.      jmp    kermt2        ; Invalid keyword
  8636.     stx    kwrk01        ; Hold offset into jump table
  8637.     jsr    prcfm        ; Parse and print a confirm
  8638.     lda    #shcmb\      ; Get addr. of jump table
  8639.     sta    jtaddr        ;
  8640.     lda    #shcmb^        ;
  8641.     sta    jtaddr+1    ;
  8642.     lda    kwrk01        ; Get offset  back
  8643.     asl    a        ; Double it
  8644.     jmp    jmpind      ;[DD] Jump
  8645. ;
  8646. shrc:    lda    #0        ; Set up index to be used later
  8647.     sta    srind
  8648.     lda    #stscmd\    ; Get the set option table address
  8649.     sta    cminf1        ;
  8650.     lda    #stscmd^    ;
  8651.     sta    cminf1+1    ;
  8652.     ldy    #0        ; No special flags needed
  8653.     lda    #cmkey        ; Code for keyword parse
  8654.     jsr    comnd        ; Try to parse it
  8655.      jmp    kermt2        ; Invalid keyword
  8656.     stx    kwrk01        ; Hold offset into jump table
  8657.     jsr    prcfm        ; Parse and print a confirm
  8658.     lda    #shcmb\        ; Get addr. ofl jump table
  8659.     sta    jtaddr        ;
  8660.     lda    #shcmb^        ;
  8661.     sta    jtaddr+1    ;
  8662.     lda    kwrk01        ; Get offset  back
  8663.     asl    a        ; Double it
  8664.     jmp    jmpind        ;[DD] Jump
  8665.  
  8666. shcmb:  jsr    shpdc        ; Show send/rec padding character
  8667.     jmp    kermit        ; Go back
  8668.     jsr    shpad        ; Show amount of padding for send/rec
  8669.     jmp    kermit        ; Go back
  8670.     jsr    shebq        ; Show send/rec eight-bit-quoting character
  8671.     jmp    kermit        ; Go back
  8672.     jsr    sheol        ; Show send/rec end-of-line character
  8673.     jmp    kermit        ; Go back
  8674.     jsr    shpl        ; Show send/rec packet length
  8675.     jmp    kermit        ; Go back
  8676.     jsr    shqc        ; Show send/rec quote character
  8677.     jmp    kermit        ; Go back
  8678.     jsr    shtim        ; Show send/rec timeout
  8679.     jmp    kermit        ; Go back
  8680.  
  8681. shpdc:  ldx    #shin11\    ; Get address of 'pad char' string
  8682.     ldy    #shin11^
  8683.     jsr    prstr        ; Print that
  8684.     ldx    srind        ; Load index so we print correct parm
  8685.     lda    padch,x        ; If index is 1, this gets spadch
  8686.     jsr    prchr        ; Print the special character
  8687.     jsr    prcrlf        ; Print a crelf after it
  8688.     rts
  8689. shpad:  ldx    #shin12\    ; Get address of 'padding amount' string
  8690.     ldy    #shin12^
  8691.     jsr    prstr        ; Print that
  8692.     ldx    srind        ; Load index so we print correct parm
  8693.     lda    pad,x        ; If index is 1, this gets spad
  8694. ;    jsr    prbyte        ; Print the amount of padding
  8695.     tax            ; lo half
  8696.     lda    #0
  8697. ;    jsr    prntad        ; print it in decimal, please
  8698. ;    jsr    prcrlf        ; Print a crelf after it
  8699.     jsr    prntadnl    ; use combined rtn
  8700.     rts
  8701. shebq:  ldx    #shin08\    ; Get address of 'eight-bit-quote' string
  8702.     ldy    #shin08^
  8703.     jsr    prstr        ; Print that
  8704.     ldx    srind        ; Load index so we print correct parm
  8705.     lda    ebq,x        ; If index is 1, this gets sebq
  8706.     jsr    prchr        ; Print the special character
  8707.     jsr    prcrlf        ; Print a crelf after it
  8708.     rts
  8709. sheol:  ldx    #shin09\    ; Get address of 'end-of-line' string
  8710.     ldy    #shin09^
  8711.     jsr    prstr        ; Print that
  8712.     ldx    srind        ; Load index so we print correct parm
  8713.     lda    eol,x        ; If index is 1, this gets seol
  8714.     jsr    prchr        ; Print the special character
  8715.     jsr    prcrlf        ; Print a crelf after it
  8716.     rts
  8717. shpl:    ldx    #shin10\    ; Get address of 'packet length' string
  8718.     ldy    #shin10^
  8719.     jsr    prstr        ; Print that
  8720.     ldx    srind        ; Load index so we print correct parm
  8721.     lda    psiz,x        ; If index is 1, this gets spsiz
  8722. ;    jsr    prbyte        ; Print the packet length
  8723.     tax
  8724.     lda    #0
  8725. ;    jsr    prntad        ; print in decimal please
  8726. ;    jsr    prcrlf        ; Print a crelf after it
  8727.     jsr    prntadnl    ; use combined rtn
  8728.     rts            ;    and return
  8729. shqc:    ldx    #shin13\    ; Get address of 'quote-char' string
  8730.     ldy    #shin13^
  8731.     jsr    prstr        ; Print that
  8732.     ldx    srind        ; Load index so we print correct parm
  8733.     lda    quote,x        ; If index is 1, this gets squote
  8734.     jsr    prchr        ; Print the special character
  8735.     jsr    prcrlf        ; Print a crelf after it
  8736.     rts
  8737. shtim:  ldx    #shin14\    ; Get address of 'timeout' string
  8738.     ldy    #shin14^
  8739.     jsr    prstr        ; Print that
  8740.     ldx    srind        ; Load index so we print correct parm
  8741.     lda    time,x        ; If index is 1, this gets stime
  8742. ;---
  8743. ;    jsr    prbyte        ; Print the hex value
  8744.     tax            ; get it into x
  8745.     lda    #0
  8746. ;    jsr    prntad
  8747. ;---
  8748. ;    jsr    prcrlf        ; Print a crelf after it
  8749.     jsr    prntadnl    ; use combined rtn
  8750.     rts
  8751.  
  8752. shsnal: lda    #1        ; Set up index for show parms
  8753.     sta    srind        ;    and stuff it here
  8754.     ldx    #shin07\    ; Get address of 'send' string
  8755.     ldy    #shin07^    ;
  8756.     jsr    prstr        ; Print it
  8757.     jsr    prcrlf        ; Print a crelf
  8758.     jsr    shpdc        ; Show the padding character
  8759.     jsr    shpad        ; Show amount of padding
  8760.     jsr    shebq        ; Show eight-bit-quote character
  8761.     jsr    sheol        ; Show end-of-line character
  8762.     jsr    shpl        ; Show packet-length
  8763.     jsr    shqc        ; Show quote character
  8764.     jsr    shtim        ; Show timeout length
  8765.     rts
  8766.  
  8767. shrcal: lda    #0        ; Set up index for show parms
  8768.     sta    srind        ;    and stuff it here
  8769.     ldx    #shin15\    ; Get address of 'receive' string
  8770.     ldy    #shin15^
  8771.     jsr    prstr        ; Print it
  8772.     jsr    prcrlf        ; Print a crelf
  8773.     jsr    shpdc        ; Show the padding character
  8774.     jsr    shpad        ; Show amount of padding
  8775.     jsr    shebq        ; Show eight-bit-quote character
  8776.     jsr    sheol        ; Show end-of-line character
  8777.     jsr    shpl        ; Show packet-length
  8778.     jsr    shqc        ; Show quote character
  8779.     jsr    shtim        ; Show timeout length
  8780.     rts
  8781.  
  8782. shmod:    jsr    prcfm        ; make sure confirmed
  8783.     ldx    #shin16\    ; Get address of 'timeout' string
  8784.     ldy    #shin16^
  8785.     jsr    prstr        ; Print that
  8786.     lda    filmod        ; Get the file-type mode
  8787. ;    cmp    #4        ; Is it >= 4?
  8788.     cmp    #ftbin+1    ; Is it >= 3? [jrd] no Script
  8789.     bmi    shmod1        ; If not just get the string and print it
  8790.     lda    #ftatas        ; [jrd] This is the index to the file-type we want
  8791. shmod1: tax            ; Hold this index
  8792.     lda    #kerftp\    ; Get the address if the file type strings
  8793.     sta    kermbs        ;
  8794.     lda    #kerftp^    ;
  8795.     sta    kermbs+1    ;
  8796.     lda    #kerfts        ; Get the string length
  8797.     pha            ; Push that
  8798.     txa            ; Fetch the index back
  8799.     pha            ; Push that parm then
  8800.     jsr    genmad        ;    call genmad
  8801.     jsr    prstr        ; Print the the string at that address
  8802.     jsr    prcrlf        ; Print a crelf after it
  8803.     rts
  8804.  
  8805. ;shfbs:    jsr    prcfm        ; make sure confirmed
  8806. ;    ldx    #shin17\    ; Get address of 'file-byte-size' string
  8807. ;    ldy    #shin17^
  8808. ;    jsr    prstr        ; Print that
  8809. ;    lda    fbsize        ; Get the file-type mode
  8810. ;    beq    shfbse        ; It is in eight-bit mode
  8811. ;    ldx    #shsbit\    ; Get address of 'SEVEN-BIT' string
  8812. ;    ldy    #shsbit^    ;
  8813. ;    jsr    prstr        ; Print that
  8814. ;    jsr    prcrlf        ;    then a crelf
  8815. ;    rts            ;    and return
  8816. ;shfbse: ldx    #shebit\    ; Get the address of 'EIGHT-BIT' string
  8817. ;    ldy    #shebit^    ;
  8818. ;    jsr    prstr        ; Print the the string at that address
  8819. ;    jsr    prcrlf        ; Print a crelf after it
  8820. ;    rts
  8821.  
  8822. shpari:    jsr    prcfm        ; make sure confirmed
  8823.     ldx    #shin20\    ; Get address of 'parity' string
  8824.     ldy    #shin20^    ;        ...
  8825.     jsr    prstr        ; Print that
  8826.     lda    parity        ; Get the parity index
  8827.     cmp    #5        ; Is it >= 5?
  8828.     bmi    shpar1        ; If not just get the string and print it
  8829.     lda    #0        ; This is the index to the parity we want
  8830. shpar1:    tax            ; Hold this index
  8831.     lda    #kerprs\    ; Get address of the parity strings
  8832.     sta    kermbs        ; And stuff it here for genmad
  8833.     lda    #kerprs^    ;        ...
  8834.     sta    kermbs+1    ;        ...
  8835.     lda    #kerpsl        ; Get the string length
  8836.     pha            ; Push that
  8837.     txa            ; Fetch the index back
  8838.     pha            ; Push that parm then
  8839.     jsr    genmad        ;    call genmad
  8840.     jsr    prstr        ; Print the the string at that address
  8841.     jsr    prcrlf        ; Print a crelf after it
  8842.     rts
  8843.  
  8844. shbad:    jsr    prcfm        ; make sure confirmed
  8845.     ldx    #shin19\    ;[17] Get the address of the 'baud' string
  8846.     ldy    #shin19^    ;[17]         ...
  8847.     jsr    prstr        ;[17] Print it
  8848.     lda    baud        ;[17] Get the baud rate
  8849.     cmp    #$0A        ;[17] Is it >= 10?
  8850.     bmi    shbad1        ;[17] No, just print the string
  8851.     lda    #bd1200        ;[17] Use 1200 baud as default
  8852. shbad1:    tax            ;[17] Hold the index here
  8853.     lda    #kerbds\    ;[17] Get the address of
  8854.     sta    kermbs        ;[17]    the baud rate strings
  8855.     lda    #kerbds^    ;[17]        ...
  8856.     sta    kermbs+1    ;[17]        ...
  8857.     lda    #kerbsl        ;[17] Get the length of the baud rate strings
  8858.     pha            ;[17] Push that
  8859.     txa            ;[17]
  8860.     pha            ;[17]
  8861.     jsr    genmad        ;[17]
  8862.     jsr    prstr        ;[17]
  8863.     jsr    prcrlf        ;[17]
  8864.     rts            ;[17]
  8865.  
  8866. shwrd:    jsr    prcfm        ; make sure confirmed
  8867.     ldx    #shin21\    ;[17] Get the address of the 'wrod-size'
  8868.     ldy    #shin21^    ;[17]    message
  8869.     jsr    prstr        ;[17] Print that
  8870.     lda    wrdsiz        ;[17] Get the word-size
  8871.     beq    shwrde        ;[17] 
  8872.     ldx    #shsbit\    ;[17] Get address of 'SEVEN-BIT' string
  8873.     ldy    #shsbit^    ;[17]        ...
  8874.     jsr    prstr        ;[17] Print that
  8875.     jsr    prcrlf        ;[17]    then a crelf
  8876.     rts            ;[17]    and return
  8877. shwrde:    ldx    #shebit\    ;[17] Get address of 'EIGHT-BIT' string
  8878.     ldy    #shebit^    ;[17]        ...
  8879.     jsr    prstr        ;[17] Print that
  8880.     jsr    prcrlf        ;[17]    and a crelf
  8881.     rts            ;[17]    and return
  8882.  
  8883. shflow:    jsr    prcfm        ; make sure confirmed
  8884.     ldx    #shin22\    ;[24]
  8885.     ldy    #shin22^    ;[24]
  8886.     jsr    prstr        ;[24]
  8887.     lda    flowmo        ;[24]
  8888.     jmp    pron        ;[24]
  8889.  
  8890. ;
  8891. ; Show default disk
  8892. ;
  8893. shdef:    jsr    prcfm        ; make sure confirmed
  8894.     ldx    #shin23\    ;[jrd] default drive string
  8895.     ldy    #shin23^    ;[jrd]
  8896.     jsr    prstr        ;[jrd]
  8897.     lda    dsknum        ;[jrd]
  8898.     jsr    cout        ;[jrd]
  8899.     jsr    prcrlf
  8900.     rts
  8901.  
  8902. .SBTTL    Status routine
  8903.  
  8904. ;
  8905. ;    This routine shows the status of the most recent transmission
  8906. ;    session.
  8907. ;
  8908. ;        Input:  NONE
  8909. ;
  8910. ;        Output: Status of last transmission is sent to screen
  8911. ;
  8912. ;        Registers destroyed:    A,X,Y
  8913. ;
  8914.  
  8915. status: jsr    prcfm        ; Parse and print a confirm
  8916.     jsr    stat01        ;[45] Go Give the status
  8917.     jmp    kermit        ;[45]   and parse for more commands
  8918.  
  8919. stat01: ldx    #stin00\    ; Get address of first line of text
  8920.     ldy    #stin00^    ;        ...
  8921.     jsr    prstr        ; Print that
  8922.     ldx    schr        ; Get low order byte of character count
  8923.     lda    schr+1        ; Get high order byte
  8924. ;    jsr    prntax        ; Print that pair in hex
  8925. ;    jsr    prntad        ; no, print it in decimal
  8926. ;    jsr    prcrlf        ; Add a crelf at the end
  8927.     jsr    prntadnl    ; use combined rtn
  8928.     ldx    #stin01\    ; Get address of second line
  8929.     ldy    #stin01^    ;        ....
  8930.     jsr    prstr        ; Print it
  8931.     ldx    rchr        ; Get L.O. byte of char count
  8932.     lda    rchr+1        ; Get H.O. byte
  8933. ;    jsr    prntax        ; Print that count
  8934. ;    jsr    prntad        ; print it in decimal
  8935. ;    jsr    prcrlf        ; Add a crelf at the end
  8936.     jsr    prntadnl    ; use combined rtn
  8937.     ldx    #stin02\    ; Get L.O. address of message
  8938.     ldy    #stin02^    ;
  8939.     jsr    prstr        ; Print message
  8940.     ldx    stot        ; Get L.O. byte of count
  8941.     lda    stot+1        ; Get H.O. byte
  8942. ;    jsr    prntax        ; Print the count
  8943. ;    jsr    prntad        ; print it in decimal
  8944. ;    jsr    prcrlf        ; Add a crelf at the end
  8945.     jsr    prntadnl    ; use combined rtn
  8946.     ldx    #stin03\    ; Get address of next status item message
  8947.     ldy    #stin03^
  8948.     jsr    prstr        ; Print it
  8949.     ldx    rtot        ; Get the proper count (L.O. byte)
  8950.     lda    rtot+1        ; Get H.O. byte
  8951. ;    jsr    prntax        ; Print the 16-bit count
  8952. ;    jsr    prntad        ; print it in decimal
  8953. ;    jsr    prcrlf        ; Add a crelf at the end
  8954.     jsr    prntadnl    ; use combined rtn
  8955.     jsr    prcrlf        ; Add a crelf at the end
  8956.     ldx    #stin04\    ; Get address of overhead message
  8957.     ldy    #stin04^    ;
  8958.     jsr    prstr        ; Print that message
  8959.     sec            ; Get ready to calculate overhead amount
  8960.     lda    stot        ; Get total character count and
  8961.     sbc    schr        ;    subtract off data character count
  8962.     tax            ; Stuff that here for printing
  8963.     lda    stot+1
  8964.     sbc    schr+1
  8965. ;    jsr    prntax        ; Print it
  8966. ;    jsr    prntad        ; print it in decimal
  8967. ;    jsr    prcrlf        ; Add a crelf at the end
  8968.     jsr    prntadnl    ; use combined rtn
  8969.     ldx    #stin05\    ; Get address of next overhead message
  8970.     ldy    #stin05^    ;        ...
  8971.     jsr    prstr        ; Print that
  8972.     sec            ; Get ready to calculate overhead amount
  8973.     lda    rtot        ; Get total character count and
  8974.     sbc    rchr        ;    subtract off data character count
  8975.     tax            ; Stuff that here for printing
  8976.     lda    rtot+1        ;        ...
  8977.     sbc    rchr+1        ;        ...
  8978. ;    jsr    prntax        ; Print the count
  8979. ;    jsr    prntad        ; print it in decimal
  8980. ;    jsr    prcrlf        ; Add a crelf at the end
  8981.     jsr    prntadnl    ; use combined rtn
  8982.     jsr    prcrlf        ; Add a crelf at the end
  8983.     ldx    #stin06\      ; Get message for 'last error'
  8984.     ldy    #stin06^    ;        ...
  8985.     jsr    prstr        ; Print the message
  8986.     jsr    prcrlf        ; Print a crelf before the error message
  8987.     lda    #eprflg        ; [jrd] ???
  8988.     bit    errcod        ; Test for 'Error packet received' bit
  8989.     bvs    statpe        ; Go process an error packet
  8990. ;
  8991. ; all this old error stuff commented out til we write the error decoder
  8992. ; for atari.
  8993. ;
  8994. ;    lda    #kerems        ; Get the error message size
  8995. ;    pha            ; Push it
  8996. ;    lda    errcod        ; Get the error message offset in table
  8997. ;    bmi    stat02        ; If this is a DOS error, do extra adjusting    
  8998. ;    pha            ; Push that
  8999. ;    lda    #erms0a\    ; Put the base address in kermbs
  9000. ;    sta    kermbs        ;        ...
  9001. ;    lda    #erms0a^    ;        ...
  9002. ;    sta    kermbs+1    ;        ...
  9003. ;    jmp    statle        ; Go print the 'last error' encountered
  9004. ;stat02:    and    #$7f        ; Shut off H.O. bit
  9005. ;    beq    stat03        ; If it is zero, we are done adjusting
  9006. ;    sec            ; Decrement by one for the unused error code
  9007. ;    sbc    #1        ;        ...
  9008. ;stat03:    pha            ; Push that parameter
  9009. ; zzz    lda    #dskers\    ; Use 'dskers' as the base address
  9010. ;    sta    kermbs        ;        ...
  9011. ;    lda    #dskers^    ;        ...
  9012. ;    sta    kermbs+1    ;        ...
  9013. ;statle:
  9014. ;    jsr    genmad        ; Translate code to address of message
  9015. ;    jsr    prstr        ; Print the text of error message
  9016. ;    jsr    prcrlf        ; Add a crelf at the end
  9017. ;;    jmp    kermit        ; Start at the top
  9018.     lda    errcod        ; [jrd] get the error code
  9019.     jsr    prerms        ; [jrd] print appropriate msg
  9020.     jsr    prcrlf        ; [jrd] and a crlf
  9021.     rts            ;[45] Return to the caller
  9022. statpe:    ldx    #errrkm\    ; L.O. byte address of remote kermit error
  9023.     ldy    #errrkm^    ; H.O. byte address...
  9024.     jsr    prstr        ; Print the text from the error packet
  9025.     jsr    prcrlf        ; Print an extra crelf
  9026. ;    jmp    kermit        ; Start at the top again
  9027.     rts            ;[45] Return to the caller
  9028.  
  9029. ;
  9030. ;    Given error code in A, return message addr in X,Y.  Preserves A.
  9031. ;
  9032. ermadr:    pha
  9033.     and    #$0F        ; not more than 15 of them
  9034.     asl    A        ; mult by 2
  9035.     tax            ; get it in x
  9036.     lda    kerrv+1,x    ; get hi byte
  9037.     tay            ; get hi byte into y
  9038.     lda    kerrv,x        ; get lo byte
  9039.     tax            ; into x
  9040.     pla
  9041.     rts
  9042. ;
  9043. ;    Print message given error code in A.  Preserves A.
  9044. ;
  9045. prerms:
  9046.     cmp    #0        ; No error?
  9047.     beq    prerms9        ; give up
  9048.     pha            ; save it
  9049.     jsr    ermadr        ; get msg addr
  9050.     cpy    #0        ; no message?
  9051.     beq    prerms8        ; print code then
  9052.     jsr    prstr        ; and go print it
  9053.     pla            ; get a back
  9054.     rts
  9055. prerms8:
  9056.     ldx    #ermess\
  9057.     ldy    #ermess^
  9058.     jsr    prstr
  9059.     pla
  9060.     pha
  9061.     jsr    prbyte        ; print the hex
  9062.     pla            ; get a back
  9063. prerms9:
  9064.     rts            ; and return
  9065.  
  9066. ;
  9067. ; take error code in A, hexify into ermsdc
  9068. ;
  9069. logdoserr:
  9070.     pha
  9071.     lsr    a
  9072.     lsr    a
  9073.     lsr    a
  9074.     lsr    a
  9075.     jsr    ny2hx        ; hexify top nybble
  9076.     sta    ermsdc
  9077.     pla
  9078.     and    #$0F
  9079.     jsr    ny2hx
  9080.     sta    ermsdc+1    ; and bot nybble
  9081.     rts
  9082.  
  9083. .SBTTL    Packet routines - SPAK - send packet
  9084.  
  9085. ;
  9086. ;    This routine forms and sends out a complete packet in the
  9087. ;    following format:
  9088. ;
  9089. ;    <SOH><char(pdlen)><char(pnum)><ptype><data><char(chksum)><eol>
  9090. ;
  9091. ;        Input:  kerbf1- Pointer to packet buffer
  9092. ;            pdlen-  Length of data
  9093. ;            pnum-    Packet number
  9094. ;            ptype-  Packet type
  9095. ;
  9096. ;        Output: A-    True or False return code
  9097. ;
  9098.  
  9099. spak:
  9100.     jsr    openrsm        ; ensure rs port open
  9101. ;    jsr    scred2        ; clear the screen
  9102. ;    ldx    #0
  9103. ;    ldy    #0
  9104. ;    jsr    scrplt        ; home the cursor
  9105.     sec            ; get cursor pos
  9106.     jsr    ploth
  9107. ;    ldy    #0        ; set col to 0
  9108.     ldx    #0        ; set col to 0
  9109.     clc            ; and put it back
  9110.     jsr    ploth
  9111.     ldx    #snin01\    ; Give the user info on what we are doing
  9112.     ldy    #snin01^    ;        ...
  9113.     jsr    prstr        ; Print the information
  9114.     ldx    #false        ;[49]
  9115.     jsr    timerset    ;[49]
  9116. ;---
  9117. ;    lda    tpak+1        ; Get the total packets count
  9118. ;    jsr    prbyte        ;    and print that
  9119. ;    lda    tpak        ;        ...
  9120. ;    jsr    prbyte        ;        ...
  9121.     ldx    tpak
  9122.     lda    tpak+1
  9123.     jsr    prntad        ; print packet num in decimal
  9124. ;---
  9125. ;    jsr    prcrlf        ; Output a crelf
  9126.     lda    #0        ; Clear packet data index
  9127.     sta    pdtind        ;        ...
  9128. spaknd: lda    spadch        ; Get the padding character
  9129.     ldx    #0        ; Init counter
  9130. spakpd: cpx    spad        ; Are we done padding?
  9131.     bcs    spakst        ;  Yes, start sending packet
  9132.     inx            ; No, up the index and count by one
  9133.     jsr    putplc        ; Output a padding character
  9134.     jmp    spakpd        ; Go around again
  9135. spakst: lda    #soh        ; Get the start-of-header char into AC
  9136.     jsr    putplc        ; Send it
  9137.     lda    pdlen        ; Get the data length
  9138.     clc            ; Clear the carry
  9139.     adc    #3        ; Adjust it
  9140.     pha            ; Save this to be added into stot
  9141.     clc            ; Clear carry again
  9142.     adc    #sp        ; Make the thing a character
  9143.     sta    chksum        ; First item,  start off chksum with it
  9144.     jsr    putplc        ; Send the character
  9145.     pla            ; Fetch the pdlen and add it into the
  9146.     clc            ;    'total characters sent' counter
  9147.     adc    stot        ;        ...
  9148.     sta    stot        ;        ...
  9149.     lda    stot+1        ;        ...
  9150.     adc    #0        ;        ...
  9151.     sta    stot+1        ;        ...
  9152.     lda    pnum        ; Get the packet number
  9153.     clc            ;        ...
  9154.     adc    #sp        ; Char it
  9155.     pha            ; Save it in this condition
  9156.     clc            ; Clear carry
  9157.     adc    chksum        ; Add this to the checksum
  9158.     sta    chksum        ;        ...
  9159.     pla            ; Restore character
  9160.     jsr    putplc        ; Send it
  9161.     lda    ptype        ; Fetch the packet type
  9162.     and    #$7F        ; Make sure H.O. bit is off for chksum
  9163.     pha            ; Save it on stack
  9164.     clc            ; Add to chksum
  9165.     adc    chksum        ;        ...
  9166.     sta    chksum        ;        ...
  9167.     pla            ; Get the original character off stack
  9168.     jsr    putplc        ; Send packet type
  9169.     ldy    #0        ; Initialize data count
  9170.     sty    datind        ; Hold it here
  9171. spaklp: ldy    datind        ; Get the current index into the data
  9172.     cpy    pdlen        ; Check against packet data length, done?
  9173.     bmi    spakdc        ; Not yet, process another character
  9174.     jmp    spakch        ; Go do chksum calculations
  9175. spakdc: lda    (kerbf1),y    ; Fetch data from packet buffer
  9176.     clc            ; Add the character into the chksum
  9177.     adc    chksum        ;        ...
  9178.     sta    chksum        ;        ...
  9179.     lda    (kerbf1),y    ; Refetch data from packet buffer
  9180.     jsr    putplc        ; Send it
  9181.     inc    datind        ; Up the counter and index
  9182.     jmp    spaklp        ; Loop to do next character
  9183. spakch: lda    chksum        ; Now, adjust the chksum to fit in 6 bits
  9184.     and    #$C0        ; First, take bits 6 and 7
  9185.     lsr    a        ;    and shift them to the extreme right
  9186.     lsr    a        ;    side of the AC
  9187.     lsr    a        ;        ...
  9188.     lsr    a        ;        ...
  9189.     lsr    a        ;        ...
  9190.     lsr    a        ;        ...
  9191.     clc            ; Now add in the original chksum byte
  9192.     adc    chksum        ;        ...
  9193.     and    #$3F        ; All this should be mod decimal 64
  9194.     clc            ;        ...
  9195.     adc    #sp        ; Put it in printable range
  9196.     jsr    putplc        ;    and send it
  9197.     lda    seol        ; Fetch the eol character
  9198.     jsr    putplc        ; Send that as the last byte of the packet
  9199.     lda    pdtind        ; Set the end of buffer pointer
  9200.     sta    pdtend        ;        ...
  9201.     lda    #0        ; Set index to zero
  9202.     sta    pdtind        ;        ...
  9203.     lda    debug        ; Is the debug option turned on?
  9204.     cmp    #off        ;        ...
  9205.     beq    spaksp        ; Nope, go stuff packet at other kermit
  9206.     lda    #0        ; Option 0
  9207.     jsr    debg        ; Do it
  9208. spaksp: lda    #0        ; Zero the index
  9209.     sta    pdtind        ;        ...
  9210. spakdl: ldx    pdtind        ; Are we done?
  9211.     cpx    pdtend        ;        ...
  9212.     bpl    spakcd        ; Yes, go call debug again
  9213.     lda    plnbuf,x    ; Get the byte to send
  9214.     jsr    putrs        ; Ship it out
  9215.     inc    pdtind        ; Increment the index once
  9216.     jmp    spakdl        ; Go to top of data send loop
  9217. spakcd: lda    debug        ; Get debug switch
  9218.     cmp    #off        ; Do we have to do it?
  9219.     beq    spakcr        ; Nope, return
  9220.     lda    #1        ; Option 1
  9221.     jsr    debg        ; Do the debug stuff
  9222. spakcr: rts            ;    and return
  9223.  
  9224. .SBTTL    Packet routines - RPAK - receive a packet
  9225.  
  9226. ;
  9227. ;    This routine receives a standard Kermit packet and then breaks
  9228. ;    it apart returning the individuals components in their respective
  9229. ;    memory locations.
  9230. ;
  9231. ;        Input:
  9232. ;
  9233. ;        Output: kerbf1- Pointer to data from packet
  9234. ;            pdlen-  Length of data
  9235. ;            pnum-    Packet number
  9236. ;            ptype-  Packet type
  9237. ;
  9238.  
  9239. rpak:    jsr    gobble        ; Gobble a line up from the port
  9240.      jmp    rpkfls        ; Must have gotten a keyboard interupt, fail
  9241.     lda    ibmmod        ; Is ibm-mode on?
  9242.     cmp    #on        ;        ...
  9243.     bne    rpakst        ; If not, start working on the packet
  9244. rpakc0:    jsr    getc        ; Any characters yet?
  9245.      jmp    rpakst        ; Got one from the keyboard
  9246.     lda    char        ;[31]
  9247.     cmp    #xon        ; Is it an XON?
  9248.     bne    rpakc0        ; Nope, try again
  9249. rpakst:
  9250. ;    jsr    scred2        ; clear the screen
  9251. ;    ldx    #$00
  9252. ;    ldy    #$00
  9253. ;    jsr    scrplt        ; home the cursor
  9254.     sec            ; get cursor pos
  9255.     jsr    ploth
  9256. ;    ldy    #0        ; set col to 0
  9257.     ldx    #0        ; set col to 0
  9258.     clc            ; and put it back
  9259.     jsr    ploth
  9260.     ldx    #rcin01\     ; Give the user info on what we are doing
  9261.     ldy    #rcin01^    ;        ...
  9262.     jsr    prstr        ; Print the information
  9263.     ldx    #true        ;[49]
  9264.     jsr    timerset    ;[49] Set the timeout length
  9265. ;---
  9266. ;    lda    tpak+1        ; Get the total packets count
  9267. ;    jsr    prbyte        ;    and print that
  9268. ;    lda    tpak        ;        ...
  9269. ;    jsr    prbyte        ;        ...
  9270.     ldx    tpak
  9271.     lda    tpak+1
  9272.     jsr    prntad
  9273. ;---
  9274. ;    jsr    prcrlf        ; Output a crelf
  9275.     lda    debug        ; Is debugging on?
  9276.     cmp    #off        ;        ...
  9277.     beq    rpaknd        ;  Nope, no debugging, continue
  9278.     lda    #2        ; Option 2 <reflect the fact we are in rpak>
  9279.     jsr    debg        ; Do debug stuff
  9280. rpaknd: lda    #0        ; Clear the
  9281.     sta    chksum        ;    chksum
  9282.     sta    datind        ;    index into packet buffer
  9283.     sta    kerchr        ;    and the current character input
  9284. rpakfs: jsr    getplc        ; Get a char, find SOH
  9285.      jmp    rpkfls        ; Got a keyboard interupt instead
  9286.     sta    kerchr        ; Save it
  9287.     and    #$7F        ; Shut off H.O. bit
  9288.     cmp    #soh        ; Is it an SOH character?
  9289.     bne    rpakfs        ; Nope, try again
  9290.     lda    #1        ; Set up the switch for receive packet
  9291.     sta    fld        ;        ...
  9292. rpklp1: lda    fld        ; Get switch
  9293.     cmp    #6        ; Compare for <= 5
  9294.     bmi    rpklp2        ; If it still is, continue
  9295.     jmp    rpkchk        ; Otherwise, do the chksum calcs
  9296. rpklp2: cmp    #5        ; Check fld
  9297.     bne    rpkif1        ; If it is not 5, go check for SOH
  9298.     lda    datind        ; Fetch the data index
  9299.     cmp    #0        ; If the data index is not null
  9300.     bne    rpkif1        ;    do the same thing
  9301.     jmp    rpkif2        ; Go process the character
  9302. rpkif1: jsr    getplc        ; Get a char, find SOH
  9303.      jmp    rpkfls        ; Got a keyboard interupt instead
  9304.     sta    kerchr        ; Save that here
  9305.     and    #$7F        ; Make sure H.O. bit is off
  9306.     cmp    #soh        ; Was it another SOH?
  9307.     bne    rpkif2        ; If not, we don't have to resynch
  9308.     lda    #0        ; Yes, resynch
  9309.     sta    fld        ; Reset the switch
  9310. rpkif2: lda    fld        ; Get the field switch
  9311.     cmp    #4        ; Is it < = 3?
  9312.     bpl    rpkswt        ; No, go check the different cases now
  9313.     lda    kerchr        ; Yes, it was, get the character
  9314.     clc            ;    and add it into the chksum
  9315.     adc    chksum        ;        ...
  9316.     sta    chksum        ;        ...
  9317. rpkswt: lda    fld        ; Now check the different cases of fld
  9318.     cmp    #0        ; Case 0?
  9319.     bne    rpkc1        ; Nope, try next one
  9320.     lda    #0        ; Yes, zero the chksum
  9321.     sta    chksum        ;        ...
  9322.     jmp    rpkef        ;    and restart the loop
  9323. rpkc1:  cmp    #1        ; Is it case 1?
  9324.     bne    rpkc2        ; No, continue checking
  9325.     lda    kerchr        ; Yes, get the length of packet
  9326.     sec            ;        ...
  9327.     sbc    #sp        ; Unchar it
  9328.     sec            ;        ...
  9329.     sbc    #3        ; Adjust it down to data length
  9330.     sta    pdlen        ; That is the packet data length, put it there
  9331.     jmp    rpkef        ; Continue on to next item
  9332. rpkc2:  cmp    #2        ; Case 2 (packet number)?
  9333.     bne    rpkc3        ; If not, try case 3
  9334.     lda    kerchr        ; Fetch the character
  9335.     sec            ;        ...
  9336.     sbc    #sp        ; Take it down to what it really is
  9337.     sta    pnum        ; That is the packet number, save it
  9338.     jmp    rpkef        ; On to the next packet item
  9339. rpkc3:  cmp    #3        ; Is it case 3 (packet type)?
  9340.     bne    rpkc4        ; If not, try next one
  9341.     lda    kerchr        ; Get the character and
  9342.     sta    ptype        ;    stuff it as is into the packet type
  9343.     jmp    rpkef        ; Go on to next item
  9344. rpkc4:  cmp    #4        ; Is it case 4???
  9345.     bne    rpkc5        ; No, try last case
  9346.     ldy    #0        ; Set up the data index
  9347.     sty    datind        ;        ...
  9348. rpkchl: ldy    datind        ; Make sure datind is in Y
  9349.     cpy    pdlen        ; Compare to the packet data length, done?
  9350.     bmi    rpkif3        ; Not yet, process the character as data
  9351.     jmp    rpkef        ; Yes, go on to last field (chksum)
  9352. rpkif3: cpy    #0        ; Is this the first time through the data loop?
  9353.     beq    rpkacc        ; If so, SOH has been checked, skip it
  9354.     jsr    getplc        ; Get a char, find SOH
  9355.      jmp    rpkfls        ; Got a keyboard interupt instead
  9356.     sta    kerchr        ; Store it here
  9357.     and    #$7F        ; Shut H.O. bit
  9358.     cmp    #soh        ; Is it an SOH again?
  9359.     bne    rpkacc        ; No, go accumulate chksum
  9360.     lda    #$FF        ; Yup, SOH, go resynch packet input once again
  9361.     sta    fld        ;        ...
  9362.     jmp    rpkef        ;        ...
  9363. rpkacc: lda    kerchr        ; Get the character
  9364.     clc            ;        ...
  9365.     adc    chksum        ; Add it to the chksum
  9366.     sta    chksum        ;    and save new chksum
  9367.     lda    kerchr        ; Get the character again
  9368.     ldy    datind        ; Get our current data index
  9369.     sta    (kerbf1),y    ; Stuff the current character into the buffer
  9370.     inc    datind        ; Up the index once
  9371.     jmp    rpkchl        ; Go back and check if we have to do this again
  9372. rpkc5:  cmp    #5        ; Last chance, is it case 5?
  9373.     beq    rpkc51        ; Ok, continue
  9374.     jmp    rpkpe        ; Warn user about program error
  9375. rpkc51: lda    chksum        ; Do chksum calculations
  9376.     and    #$C0        ; Grab bits 6 and 7
  9377.     lsr    a        ; Shift them to the right (6 times)
  9378.     lsr    a        ;        ...
  9379.     lsr    a        ;        ...
  9380.     lsr    a        ;        ...
  9381.     lsr    a        ;        ...
  9382.     lsr    a        ;        ...
  9383.     clc            ; Clear carry for addition
  9384.     adc    chksum        ; Add this into original chksum
  9385.     and    #$3F        ; Make all of this mod decimal 64
  9386.     sta    chksum        ;    and resave it
  9387. rpkef:  inc    fld        ; Now increment the field switch
  9388.     jmp    rpklp1        ; And go check the next item
  9389. rpkchk: lda    kerchr        ; Get chksum from packet
  9390.     sec            ; Set carry for subtraction
  9391.     sbc    #sp        ; Unchar it
  9392.     cmp    chksum        ; Compare it to the one this Kermit generated
  9393.     beq    rpkret        ; We were successful, tell the caller that
  9394.     lda    #errbch        ; Store the error code
  9395.     sta    errcod        ;        ...
  9396.     ldx    #erms15\    ; Create pointer to error text
  9397.     ldy    #erms15^    ;
  9398.     jsr    prstr        ; Print the chksum error
  9399.     lda    kerchr        ; Print chksum from packet
  9400.     jsr    prbyte        ;        ...
  9401.     lda    #sp        ; Space things out a bit
  9402.     jsr    cout        ;        ...
  9403.     lda    chksum        ; Now get what we calculated
  9404.     jsr    prbyte        ;    and print that
  9405. rpkfls:    lda    #0        ; Zero the index for debug mode
  9406.     sta    pdtind        ;        ...
  9407.     lda    debug        ; Is debug switch on?
  9408.     cmp    #off        ;        ...
  9409.     beq    rpkfnd        ;  Return doing no debug stuff
  9410.     lda    #3        ; Option 3 <we are in rpkfls>
  9411.     jsr    debg        ; Output debug information
  9412. rpkfnd: lda    pdlen        ; Get the packet data length
  9413.     clc            ;    and add it into the
  9414.     adc    rtot        ;    'total characters received' counter
  9415.     sta    rtot        ;        ...
  9416.     lda    rtot+1        ;        ...
  9417.     adc    #0        ;        ...
  9418.     sta    rtot+1        ;        ...
  9419.     lda    #false        ; Set up failure return
  9420.     sta    ptype        ;[DD] Set packet type false
  9421.     rts            ;    and go back
  9422. rpkret:    lda    #0        ; Zero the index for debug mode
  9423.     sta    pdtind        ;        ...
  9424.     lda    debug        ; Check debug switch
  9425.     cmp    #off        ; Is it on?
  9426.     beq    rpkrnd        ; No, return with no debug
  9427.     lda    #4        ; Yes, use option 4 <we received a packet>
  9428.     jsr    debg        ; Print out the debug info
  9429. rpkrnd: lda    pdlen        ; Get the packet data length
  9430.     clc            ;    and add it into the
  9431.     adc    rtot        ;    'total characters received' counter
  9432.     sta    rtot        ;        ...
  9433.     lda    rtot+1        ;        ...
  9434.     adc    #0        ;        ...
  9435.     sta    rtot+1        ;        ...
  9436.     lda    #true        ; Show a successful return
  9437.     rts            ;    and return
  9438. rpkpe:  ldx    #erms16\    ; Set up pointer to error text
  9439.     ldy    #erms16^    ;        ...
  9440.     jsr    prstr        ; Print the error
  9441.     lda    #errint        ; Load error code and store in errcod
  9442.     sta    errcod        ;        ...
  9443.     jmp    rpkfls        ; Go give a false return
  9444.  
  9445. .SBTTL    Timerset and Timerexp
  9446.  
  9447. ;
  9448. ;    Routines to set and check for Kermit timeouts
  9449. ;
  9450.  
  9451. ;
  9452. ;    Timerset - Set the timeout for receive or send
  9453. ;
  9454. ;    Input:    X - True for receive, false for send
  9455. ;
  9456. ;    Registers Detsroyed: A
  9457. ;
  9458.  
  9459. timerset:    
  9460.     lda    stime        ; [jrd] assume sending
  9461.     cpx    #true        ;[49] Are we receiving?
  9462.     bne    timsst        ;[49] No
  9463.     lda    rtime        ; [jrd] ok, so we're receiving
  9464. timsst:
  9465.     ldx    #0        ; [jrd] zap 'lo' byte of timer
  9466.     stx    ttime+1        ;  ... remember it's byte flipped; hi, lo
  9467.     clc            ; [jrd] shift 8 bit time offset (secs) by
  9468.     ror    A        ;  2 into 16 bits, to get ticks.
  9469.     ror    ttime+1        ;  ...
  9470.     ror    A        ;  ...
  9471.     ror    ttime+1        ;  ...
  9472.     sta    ttime        ; [jrd] put low order byte in
  9473.     lda    RTCLOK+2    ; [jrd] atari's real time clock, lo order byte
  9474.     clc            ;[49]
  9475.     adc    ttime+1        ;[49] Add in the receive timeout
  9476.     sta    ttime+1        ;[49]     and store it
  9477.     lda    ttime        ;[49] Account for the carry if any
  9478.     adc    RTCLOK+1    ; [jrd] get mid order byte of clock
  9479.     sta    ttime        ;[49]    and store it
  9480.     rts            ;[49] Return
  9481.  
  9482. ;
  9483. ;    Timerexp - Check to see if we have exceeded the timeout limit.
  9484. ;
  9485. ;    Input:  Ttim - time to timeout at
  9486. ;        Clock+1 - current time
  9487. ;
  9488. ;    Registers Destroyed: A
  9489. ;
  9490.  
  9491. timerexp:    
  9492.     lda    RTCLOK+1    ; [jrd] Atari middle byte
  9493.     cmp    ttime        ;[49] Compare it to the old minutes
  9494.     bmi    timskp        ;[49] Still less
  9495.     lda    RTCLOK+2    ; [jrd] Atari?
  9496.     cmp    ttime+1        ;[49] Compare it to the old seconds
  9497.     bmi    timskp        ;[49] Still less 
  9498. timret:    rts            ;[49] We have timed out, return
  9499. timskp:    jmp    rskp        ;[49] No timeout, return with a skip
  9500.  
  9501. .SBTTL    DEBG - debugging output routines
  9502.  
  9503. ;
  9504. ;    When the debugging option is turned on, these routines periodically
  9505. ;    display information about what data is being sent or received.
  9506. ;
  9507. ;        Input:  A-    Action type
  9508. ;            Ptype-  Packet type sent or received
  9509. ;            Pnum-    Packet number sent or received
  9510. ;            Pdlen-  Packet data length
  9511. ;
  9512. ;        Output: Display info on current packet status
  9513. ;
  9514. ;        Registers destroyed:    A,X,Y
  9515. ;
  9516.  
  9517. debg:    pha            ; save a
  9518.     jsr    prcrlf        ; Output a crelf
  9519.     pla            ; get a back
  9520.     tax            ; Hold the action code here
  9521.     sta    debinx        ; Save it here
  9522.     lda    debug        ; Get the debug switch
  9523.     cmp    #terse        ; Is it terse
  9524.     bne    debgvr        ; Nope, must be Verbose mode
  9525.     jmp    debgtr        ; Yes, to terse debug output
  9526. debgvr:    lda    state        ; Check the current state
  9527.     cmp    #0        ; If we just started this thing
  9528.     beq    debgrf        ;    then we don't need debug output yet
  9529.     cmp    #'C        ; If the transmission state is 'complete'
  9530.     beq    debgrf        ;    we don't need debug output either
  9531.     lda    #kerrts\    ; Get base address of the routine name and
  9532.     sta    kermbs        ;    action table so that we can calculate
  9533.     lda    #kerrts^    ;        ...
  9534.     sta    kermbs+1    ;        ...
  9535.     lda    #kerrns        ; Load the routine name size
  9536.     pha            ; Push that
  9537.     txa            ; Fetch the offset for the one we want
  9538.     pha            ; And push that parameter
  9539.     jsr    genmad        ; Go generate the message address
  9540.     jsr    prstr        ; Now, go print the string
  9541.     lda    ptype        ; Get the current packet type
  9542.     pha            ; Save this accross the routine calls
  9543.     jsr    cout        ; Write that out
  9544.     jsr    prcrlf        ; Now write a crelf
  9545.     pla            ; Get back the packet type
  9546.     sta    debchk        ;    and start the checksum with that
  9547.     lda    debinx        ; Get the debug action index
  9548.     bne    debg1        ; If not 'sending', continue
  9549.     jsr    debprd        ; Yes, go do some extra output
  9550. debg1:  cmp    #4        ; Have we just received a packet?
  9551.     bne    debgrt        ; No, just return
  9552.     jsr    debprd        ; Print the packet info
  9553. debgrt:    jsr    prcrlf        ; Output a crelf
  9554.     lda    #true        ; Load true return code into AC
  9555.     rts            ;    and return
  9556. debgrf:    jsr    prcrlf        ; Output a crelf
  9557.     lda    #false        ; Set up failure return
  9558.     rts            ;    and go back
  9559.  
  9560. ;
  9561. ;    Debprd - does special information output including packet number,
  9562. ;    packet data length, the entire packet buffer, and the checksum
  9563. ;    of the packet as calculted by this routine.
  9564. ;
  9565.  
  9566. debprd: jsr    prcrlf        ; Start by giving us a new line
  9567.     ldx    #debms1\    ; Get the first info message address
  9568.     ldy    #debms1^    ;        ...
  9569.     jsr    prstr        ;    and print it
  9570.     jsr    prcrlf        ; New line
  9571.     ldx    #debms3\    ; Get address of message text
  9572.     ldy    #debms3^    ;        ...
  9573.     jsr    prstr        ; Print it
  9574.     inc    pdtind        ; Pass the SOH
  9575.     ldx    pdtind        ; Get the index
  9576.     lda    plnbuf,x    ; Get the data length
  9577.     sec            ; Uncharacter this value
  9578.     sbc    #$20        ;        ...
  9579.     jsr    prbyte        ; Print the hex value
  9580.     jsr    prcrlf        ; New line
  9581.     ldx    #debms2\    ; Get address of message text
  9582.     ldy    #debms2^    ;        ...
  9583.     jsr    prstr        ; Print it
  9584.     inc    pdtind        ; Next character is packet number
  9585.     ldx    pdtind        ;        ...
  9586.     lda    plnbuf,x    ; Load it
  9587.     sec            ; Uncharacter this value
  9588.     sbc    #$20        ;        ...
  9589.     jsr    prbyte        ; Print the hex value
  9590.     jsr    prcrlf        ; New line
  9591.     inc    pdtind        ; Bypass the packet type
  9592.     ldy    #$FF        ; Start counter at -1
  9593.     sty    kwrk02        ; Store it here
  9594. debprc:    inc    kwrk02        ; Increment the counter
  9595.     ldy    kwrk02        ; Get counter
  9596.     cpy    pdlen        ; Are we done printing the packet data?
  9597.     bpl    debdon        ; If so, go finish up
  9598.     inc    pdtind        ; Point to next character
  9599.     ldx    pdtind        ; Fetch the index
  9600.     lda    plnbuf,x    ; Get next byte from packet
  9601.     jsr    prchr        ; Go output special character
  9602.     lda    #space        ; Now print 1 space
  9603.     jsr    cout        ;        ...
  9604.     jmp    debprc        ; Go check next character
  9605. debdon:    jsr    prcrlf        ; Next line
  9606.     ldx    #debms4\    ; Get the address to the 'checksum' message
  9607.     ldy    #debms4^    ;        ...
  9608.     jsr    prstr        ; Print that message
  9609.     inc    pdtind        ; Get next byte, this is the checksum
  9610.     ldx    pdtind        ;        ...
  9611.     lda    plnbuf,x    ;        ...
  9612.     sec            ; Uncharacter this value
  9613.     sbc    #$20        ;        ...
  9614.     jsr    prbyte        ; Print the hex value of the checksum
  9615.     jsr    prcrlf        ; Print two(2) crelfs
  9616.     jsr    prcrlf        ;        ...
  9617.     rts            ;    and return
  9618.  
  9619. .SBTTL    Terse debug output
  9620.  
  9621. ;
  9622. ;    This routine does brief debug output. It prints only the contents
  9623. ;    of the packet with no identifying text.
  9624. ;
  9625.  
  9626. debgtr:    txa            ; Look at Option
  9627.     cmp    #0        ; Sending?
  9628.     beq    debgsn        ; Yes, output 'SENDING: '
  9629.     cmp    #3        ; Failed receive?
  9630.     beq    debgrc        ; Yes, output 'RECEIVED: '
  9631.     cmp    #4        ; Receive?
  9632.     beq    debgrc        ; Yes, output 'RECEIVED: '
  9633.     rts            ; Neither, just return
  9634. debgsn:    ldx    #sstrng\    ; Get ready to print the string
  9635.     ldy    #sstrng^    ;        ...
  9636.     jsr    prstr        ; Do it!
  9637.     jsr    prcrlf        ; Print a crelf
  9638.     jmp    debgdp        ; Go dump the packet
  9639. debgrc:    ldx    #rstrng\    ; Get ready to print the string
  9640.     ldy    #rstrng^    ;        ...
  9641.     jsr    prstr        ; Do it!
  9642.     jsr    prcrlf        ; Print a crelf
  9643. debgdp:    ldx    pdtind        ; Get index
  9644.     cpx    pdtend        ; Are we done?
  9645.     bpl    debgfn        ; Yes, return
  9646.     lda    plnbuf,x    ; Get the character
  9647.     jsr    prchr        ; Print it
  9648.     lda    #space        ; Print a space
  9649.     jsr    cout        ;        ...
  9650.     inc    pdtind        ; Advance the index
  9651.     jmp    debgdp        ; Do next character
  9652. debgfn:    jsr    prcrlf        ; Print a crelf then...
  9653.     rts            ;    Return
  9654.  
  9655. .SBTTL    Dos routines
  9656.  
  9657. ;
  9658. ;    These routines handle files and calls to the DOS
  9659. ;
  9660.  
  9661. ;
  9662. ;    Logrcv:    Tells the user what file we're receiving.
  9663. ;    Logsnd:    Similar one for transmits.
  9664. ;        these expect primfn to contain the pathname
  9665. ;        just opened, so use them AFTER open.
  9666. ;
  9667. logrcv:
  9668.     ldx    #logrcvm\    ; print "Receiving..." msg
  9669.     ldy    #logrcvm^
  9670.     jmp    logxr        ; use common thread
  9671. logsnd:
  9672.     ldx    #logsndm\    ; print "Sending..." msg
  9673.     ldy    #logsndm^
  9674. logxr:
  9675.     jsr    prstr
  9676.     ldx    #primfn\    ; print the pathname
  9677.     ldy    #primfn^
  9678.     jsr    pstreol
  9679.     jsr    prcrlf        ; and an eol
  9680.     rts
  9681.  
  9682. ;
  9683. ;    This routine opens a file for either input or output. If it
  9684. ;    opens it for output, and the file exists, and file-warning is
  9685. ;    on, the routine will issue a warning and attempt to modify
  9686. ;    the filename so that it is unique.
  9687. ;
  9688. ;        Input:    A- Fncrea - open for read
  9689. ;               Fncwrt - open for write
  9690. ;
  9691. ;        Output:    File is opened or error is issued
  9692. ;
  9693.  
  9694. openf:
  9695.     pha            ; [jrd] save r/w code
  9696.     jsr    closers        ; [jrd] make sure the rs port's closed
  9697.     pla            ; [jrd] get r/w code back
  9698.     cmp    #fncwrt        ; [jrd] open for writing?
  9699.     beq    openfo        ; [jrd] yup
  9700. ;
  9701. ; open for read
  9702. ;
  9703. ;    lda    #dsknam\    ; [jrd] file name lo
  9704. ;    ldy    #dsknam^    ; [jrd] file name hi
  9705. ;----
  9706.     jsr    parsefcb    ; [jrd] parse the pathname
  9707.     jsr    bldprm        ; [jrd] reformat it
  9708.     lda    #primfn\
  9709.     ldy    #primfn^
  9710. ;----
  9711.     ldx    #dskchan    ; [jrd] disk IOCB please
  9712.     jsr    opencin        ; [jrd] try to open it
  9713.     jmp    opnfi1        ; [jrd] go handle status etc
  9714. ;
  9715. openfo:
  9716.     jsr    parsefcb    ; [jrd] parse and merge pathname in fcb
  9717. ;    lda    flsrw        ;[23] Get the file mode
  9718. ;    cmp    #fncwrt        ;[23] Are we opening for output?
  9719. ;    bne    opnnlu        ;[23] No, no lookup needed
  9720.     lda    #on        ;[23] Yes, set the 'first mod' switch
  9721.     sta    dosffm        ;[23]    in case we have to alter the filename
  9722.     lda    filwar        ;[23] Get the file warning switch
  9723.     cmp    #on        ;[23] Is it on?
  9724.     bne    opnnlu        ;[23] If not, don't do the lookup
  9725. opnlu:    jsr    lookup        ;[23] Do the lookup
  9726.      jmp    opnnlu        ;[23] Suceeded, open the file
  9727. ;    lda    dosffm        ;[23] Is this the first time through?
  9728. ;    cmp    #on        ;[23]        ...
  9729. ;    bne    opnalt        ;[23] If not, continue
  9730. ; need this zzz
  9731. ;    jsr    prfn        ; [jrd] print the conflicting file name
  9732.     lda    #ATEOL
  9733. ;    jsr    sputch
  9734.     jsr    scrput
  9735.     ldx    #primfn\    ; name buffer addr
  9736.     ldy    #primfn^
  9737.     jsr    pstreol        ; print eol terminated string
  9738.     ldx    #erms1a\    ;[23] Otherwise, print an error message since
  9739.     ldy    #erms1a^    ;[23]    the file already exists
  9740.     jsr    prstr        ;[23]        ...
  9741. opnalt:    jsr    alterf        ;[23] No good, go alter the filename
  9742.     jmp    opnlu        ;[23] Try the lookup again
  9743. opnnlu:    jsr    bldprm        ;[23] Build the filename again
  9744.     ldx    #dskchan    ; [jrd] make sure it's still there
  9745.     lda    #primfn\    ; [jrd] file name lo    
  9746.     ldy    #primfn^    ; [jrd] file name hi
  9747.     jsr    opencout    ; [jrd] try to open it
  9748.                 ; [jrd] and fall thru to status handler
  9749.  
  9750. opnfi1:    
  9751.     cpy    #SUCCES        ; open succeed?
  9752.     bne      opfail         ;[DD] If not, error
  9753.     lda    #0
  9754.     sta    eodind        ;[DD] Clear end of dat flag
  9755. opnex:  lda    #true        ;[DD] The open worked, return true
  9756.     rts            ;[DD]        ...
  9757. opfail:
  9758.     tya            ; save error stat
  9759.     pha
  9760.     ldx    #opnflm1\    ; print the open failure message
  9761.     ldy    #opnflm1^
  9762.     jsr    prstr
  9763.     pla            ; get the code back
  9764.     jsr    prbyte
  9765.     ldx    #opnflm2\    ; print the next part
  9766.     ldy    #opnflm2^
  9767.     jsr    prstr
  9768.     ldx    #dskchan
  9769.     lda    ICAX1,X        ; get the aux value
  9770.     jsr    prbyte
  9771.     ldx    #opnflm3\    ; print the next part
  9772.     ldy    #opnflm3^
  9773.     jsr    prstr
  9774.     ldx    #dskchan
  9775.     ldy    ICBAH,X        ; get fn ptr hi
  9776.     lda    ICBAL,X        ;  and lo
  9777.     tax            ; into x...
  9778.     jsr    pstreol        ; and print it.
  9779. ;
  9780.     ldx    #opnflm4\    ; print last part
  9781.     ldy    #opnflm4^
  9782.     jsr    prstr
  9783. ;    
  9784.     jmp    fatal        ;[DD] Failed, go handle that
  9785. ;    rts            ;[DD]        ...
  9786.  
  9787. opnflm1: .byte    ATEOL,"Open failure ",0
  9788. opnflm2: .byte    " AUX1 ",0
  9789. opnflm3: .byte    " Name '",0
  9790. opnflm4: .byte    "'",ATEOL,0
  9791. ;
  9792. ;    Lookup - searches for a filename in a directory. It is used to
  9793. ;    support file warning during the opening of a file.
  9794. ;
  9795.  
  9796. lookup:    lda    #fncrea        ;[23] Get an 'R
  9797.     sta    flsrw        ;[23] Store it in the file mode switch
  9798.     jsr    locent        ;[23] Go try to locate that file
  9799.      jmp    locfnf        ;[23] File not found? We are in good shape
  9800.     lda    #errfae        ;[23] Store the error code
  9801.     sta    errcod        ;[23]        ...
  9802.     jmp    rskp        ;[23] Return with skip, have to alter filename
  9803. locfnf:    lda    #fncwrt        ;[23] Get a 'W
  9804.     sta    flsrw        ;[23] Store that
  9805.     rts            ;[23] Return without a skip
  9806.  
  9807. ;
  9808. ;    Alterf - changes a filename in the filename buffer to make it unique.
  9809. ;    It accomplishes this in the following manner.
  9810. ;
  9811. ;        1) First time through, it finds the last significant character
  9812. ;            in the filename and appends a '.0' to it.
  9813. ;
  9814. ;        2) Each succeeding time, it will increment the trailing integer
  9815. ;            that it inserted the first time through.
  9816. ;
  9817.  
  9818. alterf:    lda    dosffm        ;[23] Get the 'first mod' flag
  9819.     cmp    #on        ;[23] Is it on?
  9820.     bne    altsm        ;[23] If not, drop into regular loop
  9821. ;
  9822.     lda    #off        ;[23] Shut the 'first mod' flag off
  9823.     sta    dosffm        ;[23]        ...
  9824.     lda    #0        ; [jrd] set ver # to zero
  9825.     sta    dosfvn        ; and drop into normal code, to inc it
  9826.     jmp    altfm        ; first mod, skip inc code
  9827. ;
  9828. altsm:                ; nth mod...
  9829.     ldx    dosfvn        ;[23] Get the file version number
  9830.     inx            ;[23] Increment it
  9831.     stx    dosfvn        ;[23] Save the new version number
  9832.     txa            ;[23] Get the version number in the AC
  9833. ; no need    cmp    #0        ;[23] Is it 0 ?
  9834.     beq    altng        ;[23] Yes, cannot alter name
  9835. altfm:
  9836.     jsr    altstv        ;[23] Go store the version
  9837.     rts            ;[23] And return
  9838. ;
  9839. altng:    lda    #errfal        ;[23] Store the error code
  9840.     sta    errcod        ;[23]        ...
  9841.     ldx    kerosp        ;[23] Get the old stack pointer
  9842.     txs            ;[23]    and restore it
  9843.     jmp    kermit        ;[23] Go back to top of loop
  9844.  
  9845. ;
  9846. ;    Altstv - stores the version number passed to it into the filename
  9847. ;    buffer at whatever position dosfni is pointing to.
  9848. ;    Hexifies the version num, and sticks it in as the file type
  9849. ;    field.  zzz later, do this in decimal
  9850.  
  9851. altstv:    
  9852. ;---
  9853. ;    ldy    dosfni        ;[23] Get the filename index
  9854. ;---
  9855.     ldy    #pnd.es        ; [jrd] extension text size
  9856.     pha            ;[23] Save the value
  9857.     lda    #2        ; new ext is two bytes
  9858.     jsr    altdep        ; stuff it in
  9859.     pla            ; get value back again
  9860.     pha            ; save once more
  9861.     lsr    a        ;[23] Shift out the low order nibble
  9862.     lsr    a        ;[23]        ...
  9863.     lsr    a        ;[23]        ...
  9864.     lsr    a        ;[23]        ...
  9865.     jsr    altstf        ;[23] Stuff the character
  9866.     pla            ;[23] Grab back the original value
  9867.     and    #$0F        ;[23] Take the low order nibble
  9868.     jsr    altstf        ;[23] Stuff the next character
  9869. ;---
  9870. ;    iny            ; bump again
  9871. ;    lda    #ATEOL        ; get an EOL
  9872. ;    sta    fcb1,y        ;  to terminate file name
  9873. ;---
  9874.     rts            ;[23]    and return
  9875.  
  9876. altstf:    ora    #$30        ;[23] Make the character printable
  9877.     cmp    #$3A        ;[23] If it is less than '9'
  9878.     bcc    altdep        ;[23]    then go depisit the character
  9879.     adc    #6        ;[23] Put the character in the proper range
  9880. altdep:
  9881. ;---
  9882. ;    sta    fcb1,y        ;[23] Stuff the character
  9883. ;---
  9884.     sta    path,y
  9885.     iny            ; bump idx
  9886.     rts            ;[23]    and return
  9887.  
  9888. ;
  9889. ;    Locent -  Try to find a file 
  9890. ;
  9891.  
  9892. locent:    jsr    bldprm        ;[23]
  9893.     ldx    #dskchan    ; [jrd] disk iocb please
  9894.     lda    #primfn\    ; [jrd] file name lo
  9895.     ldy    #primfn^    ; [jrd] file name hi
  9896.     jsr    opencin        ; [jrd] try to open it
  9897. ;
  9898. ;    jsr    rddsk          ;[23] Get disk status
  9899. ;    cmp    #00        ;[23] Is it 0?
  9900.     cpy    #SUCCES        ; open succeed?
  9901.     bne      locok         ;[23] No, file doesn't exist
  9902. ;    lda    #8        ;[23] Fle exists, close the file
  9903. ;    jsr    close        ;[23]    commodore    ...
  9904.     jsr    closec        ; and atari version ...    
  9905.     jmp    rskp        ;[23] Return with a skip!
  9906. locok:
  9907. ;    lda    #8        ;[23] File doesn't exist, close the file
  9908. ;    jsr    close        ;[23]        ...
  9909.     jsr    closec        ; [jrd] just do this on atari
  9910.     rts            ;[23] Return
  9911.  
  9912. ;
  9913. ;    Bldprm - Build the primary filename
  9914. ;
  9915.  
  9916. bldprm:
  9917. ;
  9918. ;    we assume pathnames are all merged here, and the result is 
  9919. ;    in path
  9920. ;
  9921.     lda    #path\        ; point at the pathname struct
  9922.     sta    pndptr
  9923.     lda    #path^
  9924.     sta    pndptr+1
  9925.     ldx    #primfn\    ; and point at the string
  9926.     ldy    #primfn^
  9927.     jsr    pn2str        ; convert pathname to string
  9928. ;
  9929.     rts            ;[23] Return
  9930.  
  9931. ;
  9932. ;    Parsefcb:    parse-pathname of fcb1, and merge with
  9933. ;            default, leaving result in path.
  9934. ;            Intended to be used prior to bldprm.
  9935. ;
  9936. parsefcb:
  9937.     lda    #path\        ; point at the pathname struct
  9938.     sta    pndptr
  9939.     lda    #path^
  9940.     sta    pndptr+1
  9941.     ldx    #fcb1\        ; and point at the string
  9942.     ldy    #fcb1^
  9943. parsefxy:
  9944.     jsr    parsepn        ; parse fcb1 -> path
  9945.     lda    #defpath\    ; make sure
  9946.     sta    pnddef        ;  default is set
  9947.     lda    #defpath^    ;
  9948.     sta    pnddef+1    ;
  9949.     jsr    pnmerge        ; merge default -> pathname
  9950.     rts            ; done
  9951.  
  9952. ;
  9953. ;
  9954. ;    parseifn:    parse and merge the init file pathname,
  9955. ;            leaving the result in path.
  9956. ;
  9957. parseifn:
  9958.     lda    #path\        ; point at the pathname struct
  9959.     sta    pndptr
  9960.     lda    #path^
  9961.     sta    pndptr+1
  9962.     ldx    #inifil\    ; init file pathname lo
  9963.     ldy    #inifil^
  9964.     jmp    parsefxy    ; jump into middle of parsefcb
  9965.  
  9966.  
  9967. ;
  9968. ;    Closef - closes the file which was open for transfer. 
  9969. ;
  9970.  
  9971. closef:
  9972.     jsr    closers        ; [jrd] make sure rs port's closed
  9973.     ldx    #dskchan
  9974.     jsr    closec
  9975.     lda    #true        ; the close worked, return true
  9976.     rts            ;        ...
  9977.  
  9978. ;
  9979. ;    Dirst - Get a disk directory
  9980. ;
  9981. dirhrld1: .byte    "  File        Sectors",ATEOL,0
  9982. dirhrld2: .byte    " ------------ -------",ATEOL,0
  9983. direlck: .byte    "  locked",0
  9984. dirst:    
  9985.     lda    #0        ; allow default of *.*
  9986.     jsr    enterpn        ;  and get a pathname
  9987.     jsr    prcfm        ; confirm it
  9988.     jsr    parsefcb    ; parse and merge the resultant filespec
  9989.     jsr    closers        ; make sure comm port's closed
  9990. ;    jsr    prcrlf        ; cosmetics...
  9991. ;----
  9992. ;    jsr    parsefcb    ; [jrd] parse the pathname
  9993.     jsr    bldprm        ; [jrd] reformat it
  9994.     lda    #primfn\
  9995.     ldy    #primfn^
  9996. ;----
  9997.     ldx    #dirhrld1\    ; print the directory
  9998.     ldy    #dirhrld1^    ;  herald first line
  9999.     jsr    prstr
  10000.     ldx    #dirhrld2\    ; print the directory
  10001.     ldy    #dirhrld2^    ;  herald second line
  10002.     jsr    prstr
  10003.     jsr    dirini
  10004. xdir1:
  10005.     jsr    dirnxt        ; get one
  10006.     bcs    xdir9        ; failed
  10007.     lda    #dirpath\    ; point at the pathname struct
  10008.     sta    pndptr
  10009.     lda    #dirpath^
  10010.     sta    pndptr+1
  10011.     ldx    #primfn\    ; and point at the string
  10012.     ldy    #primfn^
  10013.     jsr    pn2str        ; convert pathname to string
  10014.     lda    #space
  10015.     jsr    cout        ; print a leading space
  10016.     ldx    #primfn\    ; get the resultant pathname
  10017.     ldy    #primfn^    ; and print that
  10018.     jsr    pstreol
  10019.     lda    #15        ; tab to col 15
  10020.     sta    COLCRS        ;  for the sector count
  10021.     lda    #space        ; zap temp slot to space
  10022.     sta    strptr        ; just a temp...
  10023.     ldy    #0        ; idx
  10024. xdir2:
  10025.     sty    strptr+1
  10026.     lda    dirsect,y    ; get a byte
  10027.     cmp    #'0        ; a zero?
  10028.     beq    xdir3        ; yup, alter it maybe
  10029.     pha            ; save it for a bit
  10030.     lda    #'0        ; make the altered char a 0
  10031.     sta    strptr
  10032.     pla            ; get it back
  10033.     jmp    xdir4
  10034. xdir3:
  10035.     lda    strptr        ; get the altered version
  10036. xdir4:
  10037.     jsr    cout        ; print it
  10038.     ldy    strptr+1    ; get idx
  10039.     iny            ; bump
  10040.     cpy    #3        ; done 3 yet?
  10041.     bcc    xdir2        ; nope, go on
  10042. ;    
  10043. ; see if the file's locked
  10044. ;
  10045.     lda    dirplck        ; get the flag byte
  10046.     cmp    #space
  10047.     beq    xdir5        ; space, so not locked
  10048.     ldx    #direlck\    ; point at the string
  10049.     ldy    #direlck^
  10050.     jsr    prstr        ; and print it
  10051. xdir5:
  10052.     jsr    prcrlf        ; end line
  10053.     jmp    xdir1        ; and go back for more
  10054. xdir9:
  10055.     ldx    #primfn\    ; free space string in primfn
  10056.     ldy    #primfn^
  10057.     jsr    pstreol
  10058.     jsr    dircls
  10059.     jmp    kermit
  10060. ;-------
  10061. ;
  10062. ;    ldx    #dskchan
  10063. ;    jsr    opencdir    ; get a dir list
  10064. ;    cpy    #SUCCES        ; winning?
  10065. ;    beq    dirs1        ; yup, go print it out
  10066. ;    jmp    opfail        ; go display the error
  10067. ;dirs1:
  10068. ;    ldx    #dskchan
  10069. ;    jsr    chrin
  10070. ;    cpy    #EOFERR        ; eof?
  10071. ;    beq    dirs9
  10072. ;    cpy    #SUCCES        ; ok?
  10073. ;    beq    dirs2
  10074. ;    jmp    opfail        ; go print the error
  10075. ;dirs2:
  10076. ;;    jsr    sputch        ; put it out
  10077. ;    jsr    scrput
  10078. ;    jmp    dirs1
  10079. ;dirs9:
  10080. ;    ldx    #dskchan
  10081. ;    jsr    closec
  10082. ;    jmp    kermit        ; return to command loop
  10083.  
  10084. ;
  10085. ;    Enterpn:    Util used in rename, delete.  Enter a string
  10086. ;            from command line, parse it into path.
  10087. ;    Input:    A zero ->     default of *.*
  10088. ;          non-zero -> no default allowed
  10089. ;            Returns carry set if ng, clear otherwise
  10090. ;
  10091. enterpn:
  10092.     pha            ; save default flag
  10093.     ldx    #wildfn\    ; [jrd] default is all wild
  10094.     stx    cmdptr        ; set default pointer
  10095.     ldy    #wildfn^    ; ...
  10096.     sty    cmdptr+1    ; ...
  10097.     lda    #3        ; length of wildfn
  10098.     jsr    cmd2fcb        ; copy it in ahead of time.  shouldn't
  10099.                 ;  be necessary, but cp appears to return
  10100.                 ;  no data even though default supplied
  10101.     lda    #kerehr\    ;[40] Point to the extra help commands
  10102.     sta    cmehpt        ;[40]        ...
  10103.     lda    #kerehr^    ;[40]        ...
  10104.     sta    cmehpt+1    ;[40]        ..
  10105.     ldx    #mxfnl        ;[40] Longest length a disk string may be
  10106.     pla            ; get default flag back
  10107.     cmp    #0        ; do we default to *.*?
  10108.     bne    enterpn1    ; nope, must enter one
  10109.     ldy    #cmfehf!cmfdff
  10110. ;    ldy    #cmfdff        ;[40] Tell Comnd about extra help and def
  10111.     jmp    enterpn2    ; go enter it
  10112. enterpn1:
  10113.     ldy    #cmfehf        ; no flags, must enter one
  10114. enterpn2:
  10115.     lda    #cmifi        ;[40] Load opcode for parsing file
  10116.     jsr    comnd        ;[40] Call Comnd routine
  10117.      jmp    enterpn9    ;[40] Continue, no string parsed
  10118.     jsr    cmd2fcb        ; [jrd] get it into fcb1
  10119.     ldx    #fcb1\        ; parse it
  10120.     ldy    #fcb1^
  10121.     jsr    parsepn
  10122.     clc
  10123.     rts
  10124. enterpn9:
  10125.     sec
  10126.     rts
  10127.  
  10128. ;
  10129. ;    Rename:        Rename file(s).
  10130. ;            Expects user to enter two filespecs; which
  10131. ;            may be wildcarded.  The two names are run thru
  10132. ;            the pathname parser and merger, checked for 
  10133. ;            reasonableness, and formatted as 
  10134. ;            "Dn:NAME.1,NAME.2" for the FMS's renamer.
  10135. ;
  10136. rename:
  10137.     lda    #$FF        ; no default, must enter one
  10138.     jsr    enterpn        ; get a pathname from cmd line
  10139.     bcs    rename9        ; oops!  bad/missing pathname
  10140.     jsr    parsefcb    ; [jrd] parse and merge it
  10141.     jsr    bldprm        ; [jrd] format it to output buf
  10142. ;
  10143. ;    now get the second one
  10144. ;
  10145.     lda    #$FF        ; no default, must enter one
  10146.     jsr    enterpn        ; enter a second pathname
  10147.     bcs    rename9        ; ng, quit
  10148.     jsr    prcfm        ; confirm the whole command
  10149. ;
  10150. ; zzz check to make sure no device was specified here???
  10151. ;
  10152. ;    now must append this pathname to the one already in
  10153. ;    primfn.  find the ATEOL, stuff a comma in its place, and
  10154. ;    compute the address of the byte following, then format
  10155. ;    pathname into there.
  10156. ;
  10157.     ldy    #0        ;start at beginning
  10158.     lda    #ATEOL        ; get an eol
  10159. rename1:
  10160.     cmp    primfn,y    ; this it?
  10161.     beq    rename2        ; yup, go fix it
  10162.     iny            ; try next
  10163.     bne    rename1
  10164. rename2:
  10165.     lda    #',        ; get a comma
  10166.     sta    primfn,y    ; stuff in in
  10167.     iny            ; bump idx
  10168.     tya            ; now compute buf addr for
  10169.     clc            ;  second pathname
  10170.     adc    #primfn\    ; add lo byte to offset
  10171.     tax            ; save result in x
  10172.     lda    #primfn^    ; get hi byte
  10173.     adc    #0        ; add carry
  10174.     tay            ; into y, top byte of addr
  10175.     jsr    pn2str        ; convert it to string
  10176. ;
  10177.     jsr    closers        ; make sure comm port's closed
  10178.     ldx    #dskchan
  10179.     lda    #RENAME        ; rename command code
  10180.     sta    ICCOM,X        ; store into iocb
  10181.     jsr    iozax        ; zap aux1, aux2
  10182.     lda    #primfn\    ; set up for call to CIO
  10183.     ldy    #primfn^
  10184.     jsr    iosba        ; set buf addr in iosb
  10185.     jsr    CIOV        ; do the rename
  10186. ;
  10187. ; check status...
  10188. ;
  10189.     cpy    #SUCCES        ; ok?
  10190.     beq    rename8        ; yup, go back
  10191.     jmp    opfail        ; nope, go gripe about the error
  10192. rename8:
  10193. ;    jmp    kermit        ;[40] Go back for more commands
  10194. rename9:            ; zzz maybe some kind of error?
  10195.     jmp    kermit
  10196.  
  10197. ;
  10198. ;    Erase:        Delete files(s) on the default disk.
  10199. ;            prompts for a pathname, which may be wildcarded,
  10200. ;            and does the FMS delete op on it.
  10201. erase:
  10202.     lda    #$FF        ; no default, must enter one
  10203.     jsr    enterpn        ; get a pathname from cmd line
  10204.     bcs    erase9        ; no good, stop
  10205.     jsr    prcfm        ; confirm
  10206.     jsr    parsefcb    ; [jrd] parse and merge it
  10207.     jsr    bldprm        ; [jrd] format it to output buf
  10208.     jsr    closers        ; make sure comm port's closed
  10209. ;
  10210.     ldx    #dskchan
  10211.     lda    #DELETE        ; rename command code
  10212.     sta    ICCOM,X        ; store into iocb
  10213.     jsr    iozax        ; zap aux1, aux2
  10214.     lda    #primfn\    ; set up for call to CIO
  10215.     ldy    #primfn^
  10216.     jsr    iosba        ; set buf addr in iosb
  10217.     jsr    CIOV        ; do the rename
  10218. ;
  10219. ; check status...
  10220. ;
  10221.     cpy    #SUCCES        ; ok?
  10222.     beq    erase8        ; yup, go back
  10223.     jmp    opfail        ; nope, go gripe about the error
  10224. erase8:
  10225. ;    jmp    kermit        ;[40] Go back for more commands
  10226. erase9:                ; zzz maybe some kind of error?
  10227.     jmp    kermit
  10228.  
  10229. ;
  10230. ;    Bufill - takes characters from the file, does any neccesary quoting,
  10231. ;    and then puts them in the packet data buffer. It returns the size
  10232. ;    of the data in the AC. If the size is zero and it hit end-of-file,
  10233. ;    it turns on eofinp.
  10234. ;
  10235.  
  10236. bufill:    lda    #0        ; Zero
  10237.     sta    datind        ;    the buffer index
  10238. bufil1:    jsr    fgetc        ; Get a character from the file
  10239.      jmp    bffchk        ; Go check for actual end-of-file
  10240.     sta    kerchr        ; Got a character, save it
  10241.     tax            ;[31] and a copy to X
  10242.     lda    filmod        ;[DD] Check if conversion necessary
  10243.     cmp    #ftatas        ;[DD] Is it ATTASCII?
  10244.     bne    bufcv1        ;[DD] No
  10245. ;
  10246. ;    lda    at2as,x        ;[31] Get ASCII equivalent
  10247. ;
  10248.     ldx    #xat2as\    ; point at xlate tab
  10249.     ldy    #xat2as^
  10250.     lda    kerchr        ; and get char to xlate
  10251.     jsr    xlate
  10252. ;
  10253.     sta    kerchr        ;
  10254. ;    jmp    bufcv2        ;[jrd] no need if 'script' not there
  10255. bufcv1:
  10256. ;    cmp    #3        ;[DD] Is it Speedscript?
  10257. ;    bne    bufcv2        ;[DD] No
  10258. ;    jsr    cvs2a        ;[DD] Conv. Speedscript to ASCII
  10259. bufcv2:
  10260. bufceb: lda    ebqmod        ; Check if 8-bit quoting is on
  10261.     cmp    #on        ;        ...
  10262.     beq    bufil2        ; If it is, see if we have to use it
  10263.     jmp    bffqc        ; Otherwise, check normal quoting only
  10264. bufil2: lda    kerchr        ; Get the character
  10265.     and    #$80        ; Mask everything off but H.O. bit
  10266.     beq    bffqc        ; H.O. bit was not on, so continue
  10267.     lda    sebq        ; H.O. bit was on, get 8-bit quote
  10268.     ldy    datind        ; Set up the data index
  10269.     sta    (kerbf1),y    ; Stuff the quote character in buffer
  10270.     iny            ; Up the data index
  10271.     sty    datind        ; And save it
  10272.     lda    kerchr        ; Get the original character saved
  10273.     and    #$7F        ; Shut H.O. bit, we don't need it
  10274.     sta    kerchr        ;        ...
  10275. bffqc:  lda    kerchr        ; Fetch the character
  10276.     and    #$7F        ; When checking for quoting, use only 7 bits
  10277. bffqc0: cmp    #sp        ; Is the character less than a space?
  10278.     bpl    bffqc1        ; If not, try next possibility
  10279.     ldx    filmod        ; Get the file-type
  10280.     cpx    #ftbin        ; [jrd] IF >= binary
  10281.     bcs    bffctl        ; If it is not text, ignore <cr> problem
  10282.     cmp    #cr        ; Do we have a <cr> here?
  10283.     bne    bffctl        ; Nope, continue processing
  10284.     ldx    #on        ; Set flag to add a <lf> next time through
  10285.     stx    addlf        ;        ...
  10286.     jmp    bffctl        ; This has to be controlified
  10287. bffqc1: cmp    #del        ; Is the character a del?
  10288.     bne    bffqc2        ; If not, try something else
  10289.     jmp    bffctl        ; Controlify it
  10290. bffqc2: cmp    squote        ; Is it the quote character?
  10291.     bne    bffqc3        ; If not, continue trying
  10292.     jmp    bffstq        ; It was, go stuff a quote in buffer
  10293. bffqc3: lda    ebqmod        ; Is 8-bit quoting turned on?
  10294.     cmp    #on        ;        ...
  10295.     bne    bffstf        ; If not, skip this junk
  10296.     lda    kerchr        ;    otherwise, check for 8-bit quote char.
  10297.     cmp    sebq        ; Is it an 8-bit quote?
  10298.     bne    bffstf        ; Nope, just stuff the character itself
  10299.     jmp    bffstq        ; Go stuff a quote in the buffer
  10300. bffctl: lda    kerchr        ; Get original character back
  10301.     eor    #$40        ; Ctl(AC)
  10302.     sta    kerchr        ; Save the character again
  10303. bffstq: lda    squote        ; Get the quote character
  10304.     ldy    datind        ;    and the index into the buffer
  10305.     sta    (kerbf1),y    ; Store it in the next location
  10306.     iny            ; Up the data index once
  10307.     sty    datind        ; Save the index again
  10308. bffstf: inc    schr        ; Increment the data character count
  10309.     bne    bffsdc        ;        ...
  10310.     inc    schr+1        ;        ...
  10311. bffsdc: lda    kerchr        ; Get the saved character
  10312.     ldy    datind        ;    and the data index
  10313.     sta    (kerbf1),y    ; This is the actual char we must store
  10314.     iny            ; Increment the index
  10315.     sty    datind        ; And resave it
  10316.     tya            ; Take this index, put it in AC
  10317.     clc            ; Clear carry for addition
  10318.     adc    #6        ; Adjust it so we can see if it
  10319.     cmp    spsiz        ;    is >= spsiz-6
  10320.     bpl    bffret        ; If it is, go return
  10321.     jmp    bufil1        ; Otherwise, go get more characters
  10322. bffret: lda    datind        ; Get the index, that will be the size
  10323.     rts            ; Return with the buffer size in AC
  10324. bffchk:    lda    datind        ;[21] Get the data index
  10325.     cmp    #0        ;[21] Is it zero?
  10326.     bne    bffne        ;[21] Nope, just return
  10327.     tay            ;[21] Yes, this means the entire file has
  10328.     lda    #true        ;     been transmitted so turn on
  10329.     sta    eofinp        ;    the eofinp flag
  10330.     tya            ;[21] Get back the size of zero
  10331. bffne:  rts            ; Return
  10332.  
  10333. ;
  10334. ;    Bufemp - takes a full data buffer, handles all quoting transforms
  10335. ;    and writes the reconstructed data out to the file using calls to
  10336. ;    FPUTC.
  10337. ;
  10338.  
  10339. bufemp:    lda    #0        ; Zero
  10340.     sta    datind        ;    the data index
  10341. bfetol: lda    datind        ; Get the data index
  10342.     cmp    pdlen        ; Is it >= the packet data length?
  10343.     bmi    bfemor        ; No, there is more to come
  10344.     lda    #true        ; [jrd] say we win
  10345.     rts            ; Yes, we emptied the buffer, return
  10346. bfemor: lda    #false        ; Reset the H.O.-bit-on flag to false
  10347.     sta    chebo        ;        ...
  10348.     ldy    datind        ; Get the current buffer index
  10349.     lda    (kerbf1),y    ; Fetch the character in that position
  10350.     sta    kerchr        ; Save it for the moment
  10351.     cmp    rebq        ; Is it the 8-bit quote?
  10352.     bne    bfeqc        ; No, go check for normal quoting
  10353.     lda    ebqmod        ; Is 8-bit quoting on?
  10354.     cmp    #on        ;        ...
  10355.     bne    bfeout        ; No quoting at all, place char in file
  10356.     lda    #true        ; Set H.O.-bit-on flag to true
  10357.     sta    chebo        ;        ...
  10358.     inc    datind        ; Increment the data index
  10359.     ldy    datind        ; Fetch it into Y
  10360.     lda    (kerbf1),y    ; Get the next character from buffer
  10361.     sta    kerchr        ; Save it
  10362. bfeqc:  cmp    rquote        ; Is it the normal quote character
  10363.     bne    bfeceb        ; No, pass this stuff up
  10364.     inc    datind        ; Increment the data index
  10365.     ldy    datind        ;    and fetch it in the Y-reg
  10366.     lda    (kerbf1),y    ; Get the next character from buffer
  10367.     sta    kerchr        ; Save it
  10368.     and    #$7F        ; Check only 7 bits for quote
  10369.     cmp    rquote        ; Were we quoting a quote?
  10370.     beq    bfeceb        ; Yes, nothing has to be done
  10371.     cmp    rebq        ; Check for eight-bit quote char as well
  10372.     beq    bfeceb        ; Skip the character adjustment
  10373.     lda    kerchr        ; Fetch back the original character
  10374.     eor    #$40        ; No, so controlify this again
  10375.     sta    kerchr        ; Resave it
  10376. bfeceb: lda    chebo        ; Is the H.O.-bit-on flag lit?
  10377.     cmp    #true        ;        ...
  10378.     bne    bfeout        ; Just output the character to the file
  10379.     lda    kerchr        ; Fetch the character
  10380.     ora    #$80        ; Light up the H.O. bit
  10381.     sta    kerchr        ; Resave it
  10382. bfeout: lda    filmod        ; Check if this is a text file
  10383.     cmp    #ftbin        ; [jrd] Filmod < 2 ?
  10384.     bcs    bfefpc        ; If not, continue normal processing
  10385.     lda    kerchr        ; Get a copy of the character
  10386.     and    #$7F        ; Make sure we test L.O. 7-bits only
  10387.     tax            ;[31] Put a copy in X
  10388.     cmp    #cr        ; Do we have a <cr>?
  10389.     bne    bfeclf        ; No, then check for <lf>
  10390.     lda    #on        ; Yes, set the 'Delete <lf>' flag
  10391.     sta    dellf        ;        ...
  10392.     jmp    bfefpc        ; And then continue
  10393. bfeclf: cmp    #lf        ; Do we have a <lf>?
  10394.     bne    bfenlf        ; Nope, We must go shut the Dellf flag.
  10395.     lda    dellf        ; We have a <lf>, is the flag on?
  10396.     cmp    #on        ;        ...
  10397.     bne    bfefpc        ; If not, continue normally
  10398.     lda    #off        ; Flag is on, <lf> follows <cr>, ignore it
  10399.     sta    dellf        ; Start by zeroing flag
  10400.     jmp    bfeou1        ; Now go to end of loop
  10401. bfenlf: lda    #off        ; Zero Dellf
  10402.     sta    dellf        ;        ...
  10403. bfefpc: lda    filmod        ;[DD] Get file type 
  10404.     cmp    #ftatas        ;[DD] Check ATTASCII
  10405.     bne    bfefp2        ;[DD]
  10406. ;
  10407. ;    lda    as2at,x        ;[31] Get ATASCII equivalent
  10408. ;
  10409.     ldx    #xas2at\    ; point at xlate tab
  10410.     ldy    #xas2at^
  10411.     lda    kerchr
  10412.     jsr    xlate
  10413. ;
  10414.     sta    kerchr        ;[31]
  10415. ;    jmp    bfefp3        ;[jrd] no need if no 'script'
  10416. bfefp2:
  10417. ;    cmp    #3        ;[DD] Check Speedscript
  10418. ;    bne    bfefp3        ;[DD]
  10419. ;    jsr    cva2s        ;[DD] Convert ASCII to Speedscript
  10420. bfefp3: lda    kerchr        ; Get the character once more
  10421.     jsr    fputc        ; Go write it to the file
  10422.      jmp    bfeerr        ; Check out the error
  10423.     inc    rchr        ; Increment the 'data characters receive' count
  10424.     bne    bfeou1        ;        ...
  10425.     inc    rchr+1        ;        ...
  10426. bfeou1: inc    datind        ; Up the buffer index once
  10427.     jmp    bfetol        ; Return to the top of the loop
  10428.  
  10429. bfeerr:
  10430. ;    and    #$7F        ; Shut off H.O. bit
  10431. ;    sta    errcod        ; Store the error code where it belongs
  10432. ; fputc stored the error code
  10433.     lda    #false        ; Indicate failure
  10434.     rts            ;    and return
  10435.  
  10436.  
  10437. ;
  10438. ;    Getnfl - returns the next filename to be transferred, in fcb1.
  10439. ;    Returns EOF if out of files
  10440. ;
  10441.  
  10442. getnfl:
  10443. ;
  10444. ; wildcard support added here by jrd
  10445. ;
  10446.     jsr    ssfnxt        ; set up next file name
  10447.     bcs    getnf1        ; cs means no more
  10448.     lda    #false        ; say we're not at end of file list
  10449.     rts            ; and return
  10450. getnf1:
  10451.     lda    #eof        ; No more files (return eof)
  10452.     rts
  10453.  
  10454. ;
  10455. ;    Getfil - gets the filename from the receive command if one was
  10456. ;    parsed. Otherwise, it returns the name in the file header packet.
  10457. ;
  10458.  
  10459. getfil: lda    usehdr        ; Get the use-header switch
  10460.     cmp    #on        ; Is it on
  10461.     bne    getfl1        ; If not, keep what we have in the fcb
  10462.     jsr    clrfcb        ;        ...
  10463.     ldy    #0        ; Initialize the y reg
  10464. ;    lda    pdlen        ; Copy the packet data length
  10465. ;    sec            ; Now subtract off the overhead
  10466. ;    sbc    #3        ;        ...
  10467. ;    sta    kwrk02        ;    into a work area
  10468. getfl0: lda    (kerbf1),y    ; Get a character from the packet buffer
  10469.     sta    fcb1,y        ; Stuff it in the fcb
  10470.     iny            ; Up the index once
  10471.     cpy    pdlen        ; Are we finished?
  10472.     bmi    getfl0        ; Nope, go do next byte
  10473. ;    lda    #0        ;
  10474. ;    sta    fcb1,y        ; Nul at end
  10475. getfl1: rts
  10476.  
  10477.  
  10478. ;
  10479. ;    Fgetc - returns the next character from the file in the AC. It
  10480. ;    handles all of the low level disk I/O. Whenever it successfully
  10481. ;    gets a character, it skips on return. If it does not get a
  10482. ;    character, it doesn't skip.
  10483. ;
  10484.  
  10485. fgetc:    lda    addlf        ; Get the 'add a lf' flag
  10486.     cmp    #on        ; Is it on?
  10487.     bne    fgetc1        ; No, continue with normal processing
  10488.     lda    #off        ; Zero the flag first
  10489.     sta    addlf        ;        ...
  10490.     lda    #lf        ; Get a <lf>
  10491.     jmp    fgtexi        ;   and return that as the next character
  10492. fgetc1: lda    eodind        ;[DD] Check end-of-data flag
  10493.     cmp    #off        ;[21] Is it on?
  10494.     beq    fgtc2a        ;[DD][21] No, get next character
  10495.     jmp    fgteof        ;[21] Yes, no data to read
  10496. fgtc2a:
  10497.     ldx    #dskchan    ; [jrd] Disk iocb please
  10498.     jsr    chrin        ; [jrd] get one byte please
  10499.     pha            ;[DD] Save it
  10500.     cpy    #SUCCES        ; [jrd] get one?
  10501.     beq    fgtgnc        ; Return
  10502.     lda    #1        ; [jrd] set eodind; any error -> eof
  10503.                 ;  zzz put some code in here to bitch
  10504.                 ;  about errors other than eof
  10505.     sta    eodind        ; say end of data for next time
  10506.     cpy    #3        ; EOF lookahead?
  10507.     beq    fgtgn0        ; yup, close and return it
  10508.     cpy    #EOFERR        ; a real eof?
  10509.     beq    fgteof0        ; yup, close it and don't return
  10510. ; debugging
  10511. ;    tya            ; save code for a sec
  10512. ;    pha
  10513. ;    ldx    #fgtdbg\
  10514. ;    ldy    #fgtdbg^
  10515. ;    jsr    prstr
  10516. ;    pla
  10517. ;    jsr    prbyte
  10518. ;    jsr    prcrlf
  10519. ;---
  10520.     tya            ; get code into a
  10521.     jsr    logdoserr
  10522.     lda    #errfde        ; say we got an io error
  10523.     sta    errcod
  10524. ;
  10525. ; what a crock! there's no way to return an error indication from this
  10526. ; thing.  Give up.  Print the error here, and go thru fatal error vect
  10527. ; to reset stack
  10528. ;
  10529.     jsr    prerms
  10530.     jmp    fatal
  10531. ;
  10532. fgtgn0:    jsr    closef        ;[DD] Eof so close but return
  10533. fgtgnc:    pla            ; Get back character
  10534. fgtgn1:
  10535. ; obsolete
  10536. ;    ldx    fbsize        ; Get the file-byte-size
  10537. ;    cpx    #fbsbit        ; Is it seven-bit?
  10538. ;    bne    fgtexi        ; If not, leave with character intact
  10539. ;    and    #$7f        ; Shut off the H.O. byte
  10540. fgtexi:    jmp    rskp          ; Return skip
  10541. ;
  10542. fgteof0:
  10543.     pla            ; [jrd, v3.6] pop dead char, to fix stack
  10544. fgteof:    jsr    closef        ; close the file
  10545.     lda    #0        ; Return null
  10546.     rts            ;        ... 
  10547. ;
  10548. ;fgtcan: jmp    fatal         ; Just go give an error
  10549. ;
  10550. ;fgtdbg:    .byte    "Fgetc error ",0
  10551. ;
  10552. ;
  10553. ;    Fputc - takes a character passed to it in the AC and writes it
  10554. ;    to the file being transferred in.
  10555. ;
  10556.  
  10557. fputc:
  10558.     ldx    #dskchan    ; [jrd] disk iocb please
  10559.     jsr    chrout        ;[DD] Write it to disk
  10560. ;    jsr    readst        ;[DD] Check for errors
  10561. ;    cmp    #00        ;[DD] Do we really need this?
  10562.     cpy    #SUCCES        ; [jrd] io succeed?
  10563.     beq    fputex        ;[DD] No error
  10564. ;    sta    errcod      ;[DD] If error
  10565. ;---
  10566. ;    sty    errcod
  10567. ;    ldx    #erms0a\    ;[DD] Get the address of the error message
  10568. ;    ldy    #erms0a^    ;[DD]        ...
  10569. ;    jsr    prstr       ;[DD] Print message
  10570. ;    lda    errcod        ;[DD]     and status
  10571. ;    jsr    prbyte      ;[DD]        ...
  10572. ;    jsr    prcrlf
  10573. ;---
  10574.     tya
  10575.     jsr    logdoserr    ; format the code into the msg
  10576.     lda    #errfde        ; say what we got
  10577.     sta    errcod
  10578. ;---
  10579. ; ???    jmp    fatal        ;[DD] Blow up
  10580.     rts            ; [jrd] return without skip, ie error
  10581. fputex: lda    #00        ; Return null
  10582.     jmp    rskp          ;     with a skip!
  10583.  
  10584. .SBTTL    Save and Restore Parameters
  10585.  
  10586. ;    The following routines will save and restore kermit 
  10587. ;    parameters in a file named 'KERMIT.INI'. Eventually 
  10588. ;    will add ability to specify file for save/restore.
  10589. ;
  10590.  
  10591. ;
  10592. ;    Savst - Save parameters
  10593. ;
  10594. ;    Registers Destroyed: A,X,Y
  10595. ;
  10596.  
  10597. savst:    jsr    closers
  10598.     jsr    prcfm        ;[47] Parse and print a confirm
  10599.     ldx    #inifil\    ; [jrd] point at file name
  10600.     ldy    #inifil^    ;  ...
  10601.     jsr    parseifn    ; parse init file pathname
  10602.     jsr    bldprm        ; [jrd] reformat it
  10603.     lda    #primfn\
  10604.     ldy    #primfn^
  10605.     ldx    #dskchan
  10606.     jsr    opencout    ; [jrd] try to open it
  10607.     cpy    #SUCCES        ; winning?
  10608.     beq    savst1        ; yup. go ahead and save
  10609.     jmp    opfail        ; nope, say why
  10610. savst1:
  10611.     ldy    #0        ;[47] Start with the escape character
  10612. savlop:    
  10613.     sty    strptr        ; [jrd] temp
  10614.     lda    escp,y        ;[47]        ...
  10615.     ldx    #dskchan
  10616.     jsr    chrout        ;[47] Write it to disk
  10617. ; zzz check status
  10618.     ldy    strptr        ; get idx back
  10619.     iny            ;[47]
  10620.     cpy    #quote+1-escp    ;[47] Are we at the end?
  10621.     bne    savlop        ;[47] No, do the next parameter
  10622.     jsr    closef
  10623.     jmp    kermit        ;[47]    and parse for more commands
  10624.  
  10625. ;
  10626. ;    Restst - Restore parameters
  10627. ;
  10628.  
  10629. restst:    jsr    prcfm        ;[47] Parse and print a confirm
  10630.     jsr    restin        ;[47] Go restore the parameters
  10631.     jmp    kermit        ;[47] Failed, restart kermit
  10632.  
  10633. restin:
  10634.     jsr    closers        ; make sure comm port's closed
  10635.     ldx    #inifil\    ; [jrd] point at file name
  10636.     ldy    #inifil^    ;  ...
  10637.     jsr    parseifn    ; parse init file pathname
  10638.     jsr    bldprm        ; [jrd] reformat it
  10639.     lda    #primfn\
  10640.     ldy    #primfn^
  10641.     ldx    #dskchan
  10642.     jsr    opencin        ; [jrd] try to open it
  10643.     cpy    #SUCCES        ; winning?
  10644. ; zzz check for file not found here
  10645.     bne    rsterr        ; nope, give up
  10646.     ldy    #0        ;[47] Start index at escp
  10647. rstlop:    sty    savey        ;[47] Save the current index
  10648.     ldx    #dskchan    ; [jrd] point at disk IOCB
  10649.     jsr    chrin        ;[47] Get a byte from the disk
  10650. ; zzz save status somewhere?
  10651.     ldy    savey        ;[47] Restore the index
  10652.     sta    escp,y        ;[47] Store the character away
  10653.     iny            ;[47] Increment the index
  10654.     cpy    #quote+1-escp    ;[47] Are we at the end of the parameter list?
  10655.     bne    rstlop        ;[47] No, get next parameter
  10656. ;    lda    scrtype        ; check if the new screen driver exists
  10657. ;    jsr    scrtst        ; [jrd] no need, they're all here
  10658. ;    bcc    rstlop1        ; no it doesnt
  10659. rsterr:    lda    #scr80        ; default to 80-columns
  10660.     sta    conscrt
  10661. rstlop1: 
  10662. ; not til connect time
  10663. ;     jsr    scrent        ; initilize the new screen package
  10664. ;    lda    #8        ;[47] Close the init file
  10665. ;    jsr    close        ;[47]        ...
  10666.     ldx    #dskchan
  10667.     jsr    closec
  10668.     rts            ; all done
  10669.  
  10670. inifil:    .byte    "KERMIT.INI",ATEOL    ; init file, eol terminated
  10671. ;
  10672. .SBTTL    Utility routines
  10673.  
  10674. ;
  10675. ;    The following routines are short low-level routines which help
  10676. ;    shorten the code and make it more readable
  10677. ;
  10678. ;
  10679. ;    Incn - increment the packet sequence number expected by this
  10680. ;    Kermit. Then take that number Mod $3f.
  10681. ;
  10682.  
  10683. incn:    pha            ; Save AC
  10684.     lda    n        ; Get the packet number
  10685.     clc            ; Clear the carry flag for the add
  10686.     adc    #1        ; Up the number by one
  10687.     and    #$3F        ; Do this Mod $3f!
  10688.     sta    n        ; Stuff the number where it belongs
  10689.     clc            ; Clear carry again
  10690.     lda    tpak        ; Increment lo byte
  10691.     adc    #1        ;    total packet count
  10692.     sta    tpak        ;        ...
  10693.     lda    tpak+1        ; Do H.O. byte
  10694.     adc    #0        ;        ...
  10695.     sta    tpak+1        ;        ...
  10696.     pla            ; Restore the AC
  10697.     rts            ;    and return
  10698.  
  10699. ;
  10700. ;    Prcerp - Process error packet. Moves the Remote Kermit error
  10701. ;    text into a save area, notes that there was an error received
  10702. ;    from the remote Kermit in Errcod (set H.O. bit), and displays
  10703. ;    the text on the screen.
  10704. ;
  10705.  
  10706. prcerp:    lda    ptype        ; Reload the packet type
  10707.     cmp    #'E        ; Is it an error packet?
  10708.     beq    prcer1        ; Yes, continue processing
  10709.     rts            ; No, return
  10710. prcer1:    lda    #pdbuf\        ; Set up from-address
  10711.     sta    kerfrm        ;        ...
  10712.     lda    #pdbuf^        ;        ...
  10713.     sta    kerfrm+1    ;        ...
  10714.     lda    #errrkm\    ; Set up the to-address
  10715.     sta    kerto        ;        ...
  10716.     lda    #errrkm^    ;        ...
  10717.     sta    kerto+1        ;        ...
  10718.     ldy    pdlen        ; Get packet data length
  10719.     sty    kwrk01        ; Store for the copy routine
  10720.     lda    #0        ; Start by storing a null at the end
  10721.     sta    (kerto),y    ;        ...
  10722.     jsr    kercpy        ; Copy the error text
  10723.     lda    errcod        ; Set the bit in the error code
  10724.     ora    #eprflg        ;    saying that the remote Kermit sent us
  10725.     sta    errcod        ;    an error packet.
  10726.     jsr    prcrlf        ; [jrd] leading crlf please
  10727.     ldx    #errrkm\    ; Finally, display the error packet
  10728.     ldy    #errrkm^    ;        ...
  10729.     jsr    prstr        ; Print string
  10730.     jsr    prcrlf        ; Make it look neat, add a crlf
  10731.     rts            ; Return to caller
  10732.  
  10733. ;
  10734. ;    Gobble - snarfs a line of characters from the port up to
  10735. ;    the receive end-of-line character. If it sees a keyboard
  10736. ;    interupt, it punts and does not skip.
  10737. ;
  10738.  
  10739. gobble:
  10740.     jsr    openrsm        ; ensure rs port open
  10741.     lda    #0        ; Zero the index pointing to end of line buffer
  10742.     sta    pdtend        ;        ...
  10743. ; zzz?    sta    ndx        ; Make sure no unwarranted keyboard intrpt
  10744. gobb:    jsr    getc        ; Get a character
  10745.      jmp    gobb2        ; Got a keyboard interupt
  10746.     lda    char        ;[31]
  10747.     cmp    #soh        ; Is it a start-of-header?
  10748.     bne    gobb        ; No, flush until first SOH
  10749.     jmp    gobbst        ; Ok, now we can start
  10750. gobb0:    jsr    getc        ; Get a character
  10751.      jmp    gobb2        ; Got a keyboard interupt
  10752.     lda    char        ;[31]
  10753.     cmp    #soh        ; If this not an SOH
  10754.     bne    gobb1        ;    continue here
  10755.     tax            ; Hold the character here
  10756.     lda    #0        ; Rezero the index pointing to end of buf
  10757.     sta    pdtend        ;        ...
  10758.     txa            ; Get the SOH back
  10759.     jmp    gobbdb        ; Go stuff the character in the buffer
  10760. gobb1:    cmp    reol        ; Is it the end-of-line character?
  10761.     beq    gobb3        ; Yes, finish up
  10762. gobbst:    ldx    pdtend        ; Get the index we need
  10763. gobbdb:    sta    plnbuf,x    ; Stuff the character at the buffer
  10764.     inc    pdtend        ; Increment the index once
  10765.     jmp    gobb0        ; Loop for another character
  10766. gobb2:    rts            ; Just return, no skip
  10767. gobb3:    ldx    pdtend        ; Get end pointer again
  10768.     sta    plnbuf,x    ; Store the End-of-line before we leave
  10769.     lda    #0        ; Zero the index, leave eob ptr where it is
  10770.     sta    pdtind        ;        ...
  10771.     jmp    rskp        ; Return with a skip!
  10772.  
  10773. ;
  10774. ;    Getplc - gets a character from the port line buffer and
  10775. ;    returns it. If the buffer is empty, it returns without
  10776. ;    skipping.
  10777. ;
  10778.  
  10779. getplc: ldx    pdtind        ; Get the current index
  10780.     cpx    pdtend        ; Less than the end buffer pointer?
  10781.     bmi    getpl1        ; If so, go return the next character
  10782.     rts            ; Return without a skip
  10783. getpl1: lda    plnbuf,x    ; Get the next character from the buffer
  10784.     inc    pdtind        ; Up the index once
  10785.     jmp    rskp        ; Return with a skip!
  10786.  
  10787. ;
  10788. ;
  10789. ;    Putplc - puts a character to the port line buffer.
  10790. ;
  10791.  
  10792. putplc: ldx    pdtind        ; Get the current index
  10793.     inx            ; Check if we are at end of buffer
  10794.     bne    putpl1        ; No, continue
  10795.     rts            ; Return without a skip
  10796. putpl1: dex            ; Set index back to what it was
  10797.     sta    plnbuf,x    ; Get the next character from the buffer
  10798.     inc    pdtind        ; Up the index once
  10799.     rts            ; Return
  10800.  
  10801. ;
  10802. ;    Getc - skip returns with a character from the port or does
  10803. ;    a normal return if a key from the keyboard is received first.
  10804. ;    If it skips, the character from the port is returned in the
  10805. ;    AC.
  10806. ;
  10807.  
  10808. getc:    jsr    getkey        ; Try and get a keyboard character
  10809. ;    bne    getcy        ;[] Got one
  10810.     bcc    getcy        ; [jrd] got one
  10811.     jmp    getc1        ;[] None available, try port
  10812. getcy:    lda    char        ;[31] Get the character read
  10813.     and    #$7F        ; Shut H.O. bit
  10814.     cmp    #ctrlx        ;[43] Was it an 'abort current file' interrupt?
  10815.     beq    getc3        ; Yes
  10816. getc2:    cmp    #ctrly        ;[43] Was it 'abort file group' interrupt ?
  10817.     bne    getc0        ;[43] Nope, continue
  10818. getc3:    lda    #errfta        ; Error code for 'file trans abort'
  10819.     sta    errcod        ; Stuff it here
  10820.     jsr    closef        ;[28] Close the current file
  10821. abo0:    lda    #0        ;[43] Send a 'Z' packet with a 'D' field
  10822.     sta    numtry        ;[43]
  10823.     sta    tpak        ;[43]
  10824.     sta    tpak+1        ;[43]
  10825.     lda    #pdbuf\        ;[43] Get the address of the packet buffer
  10826.     sta    kerbf1        ;[43]   and save it for Spak
  10827.     lda    #pdbuf^        ;[43]        ...
  10828.     sta    kerbf1+1    ;[43]        ...
  10829. abo1:    lda    numtry        ;[43] Fetch the number of tries
  10830.     cmp    maxtry        ;[43] Have we exceeded Maxtry?
  10831.     bmi    abo3        ;[43] Not yet, go send the packet
  10832. abo2:    ldx    #ermesc\    ;[43] Yes, give an error message
  10833.     ldy    #ermesc^    ;[43]        ...
  10834.     jsr    prstr        ;[43]        ...
  10835.     jsr    prcrlf        ;[43]        ...
  10836.     jmp    abo4        ;[43]    and restart kermit
  10837. abo3:    inc    numtry        ;[43] Increment the number of tries for packet
  10838.     lda    #0        ;[43] Make it packet number 0
  10839.     sta    pnum        ;[43]        ...
  10840.     lda    #1        ;[43] Data length is only 1
  10841.     sta    pdlen        ;[43]        ...
  10842.     lda    #'D        ;[43] The 'Discard' command
  10843.     sta    pdbuf        ;[43] Put that in first character of buffer
  10844.     lda    #'Z        ;[43] EOF command packet type
  10845.     sta    ptype        ;[43]        ...
  10846.     jsr    flshin        ;[43] Flush the RS232 buffer
  10847.     jsr    spak        ;[43] Send the packet
  10848.     ;jsr    rpak        ;[43] Try to fetch an ACK
  10849.     ;cmp    #true        ;[43] Did we receive successfully?
  10850.     ;bne    abo1        ;[43] No, try to send the packet again
  10851.     ;lda    ptype        ;[43] Get the type
  10852.     ;cmp    #'Y        ;[43] An ACK?
  10853.     ;bne    aboce        ;[43] No, go check for error
  10854.     jmp    abo4        ;[43] Yes, restart Kermit
  10855. aboce:    ;cmp    #'E        ;[43] Error packet?
  10856.     ;bne    abo1        ;[43] Nope, resend packet
  10857.     ;jsr    prcerp        ;[43] Go display the error
  10858.  
  10859. abo4:
  10860. ;    ldx    kerosp        ; Get the old stack pointer back
  10861. ;    txs            ; Restore it
  10862.     jmp    kermit        ; Warmstart kermit
  10863.  
  10864. getc0:  lda    #0        ;[EL] And reset the strobe
  10865. ; zzz?    sta    ndx        ;[EL]        ...
  10866.     rts            ; Keyboard interupt, return
  10867. getc1:    jsr    timerexp    ;[49] Have we timed out?
  10868.      jmp    getc0        ;[49] Yes return
  10869.     jsr    getrs        ; No, Check the port
  10870.     beq    getcn        ;[] Got a character
  10871.     jmp    getc        ;[] No char, go back to top of loop
  10872. getcn:    lda    char        ;[31] Get the character read
  10873.     jmp    rskp        ;    and return skip!
  10874.  
  10875. ;
  10876. ;    Prson - parses an 'on' or an 'off' keyword and passes
  10877. ;    the result back to the calling routine in the x-index
  10878. ;    register. If there is an error, it pops the return
  10879. ;    address off the stack and transfers control to kermt2
  10880. ;    to issue the error message.
  10881. ;
  10882.  
  10883. prson:  lda    #oncmd\        ; Command table address
  10884.     sta    cminf1        ;        ...
  10885.     lda    #oncmd^        ;        ...
  10886.     sta    cminf1+1    ;        ...
  10887.     lda    #shon\        ; Set up default string for parse
  10888.     sta    cmdptr        ;        ...
  10889.     lda    #shon^        ;        ...
  10890.     sta    cmdptr+1    ;        ...
  10891.     ldy    #cmfdff        ; Show there is a default
  10892.     lda    #cmkey        ; Code for keyword
  10893.     jsr    comnd        ; Go do it
  10894.      rts            ; The command was not recognized
  10895.      nop
  10896.      nop
  10897.     jmp    rskp        ; Good, skip return
  10898.  
  10899. ;
  10900. ;    prcfm - parses for a confirm, then transfers control directly
  10901. ;    to the top of the main loop
  10902. ;
  10903.  
  10904. prcfm:  lda    #cmcfm        ; Load token for confirm
  10905.     jsr    comnd        ; Parse a confirm
  10906.      jmp    kermt3        ; No confirm, give an error
  10907. ;    lda    #cr        ; Print a crlf
  10908. ;    jsr    cout        ;        ...
  10909.     jsr    prcrlf
  10910.     rts            ; Return
  10911.  
  10912. ;
  10913. ;    Pron - checks the value in the AC and prints either 'ON' or
  10914. ;    'OFF'. (on=1, off=0).
  10915. ;
  10916.  
  10917. pron:    cmp    #on        ; Should we print 'on'?
  10918.     bne    pron1        ; No, go print 'off'
  10919.     ldx    #shon\        ; Point to the 'on' string
  10920.     ldy    #shon^        ;        ...
  10921. pron0:  jsr    prstr        ; Print it
  10922.     jsr    prcrlf        ; Add a crelf at the end
  10923.     rts            ; And return
  10924. pron1:  ldx    #shoff\        ; Point to the 'off' string
  10925.     ldy    #shoff^        ;        ...
  10926.     jmp    pron0        ; Go print it
  10927.  
  10928. ;
  10929. ;    Clrfcb - clears the area FCB1 so the filename placed there
  10930. ;    will not be corrupted.
  10931. ;
  10932.  
  10933. clrfcb:    ldx    #mxfnl        ; Load max filename length
  10934.     lda    #ATEOL        ; [jrd] atari wants file name terminated by EOL
  10935. clrfc1:    sta    fcb1,x        ; Stuff the space
  10936.     dex            ; Decrement our pointer
  10937.     bpl    clrfc1        ; Not done, go back
  10938.     rts            ; Return
  10939.  
  10940. ;
  10941. ;    Kercpy - copies the string pointed to by Kerfrm to the
  10942. ;    block of memory pointed to by Kerto for Kwrk01 characters.
  10943. ;
  10944.  
  10945. kercpy:    ldy    kwrk01        ; Get the length of the string
  10946. kerclp:    dey            ; One character less
  10947.     bmi    kercrt        ; If this went negative, we're done
  10948.     lda    (kerfrm),y    ; Get the next character
  10949.     sta    (kerto),y    ; And put it where it belongs
  10950.     jmp    kerclp        ; Go back for next char
  10951. kercrt:    rts            ; Job is done, return
  10952.  
  10953. ;
  10954. ;    cmd2fcb:    Command buffer to fcb copier.
  10955. ;            Expects x,y pointing to buf,
  10956. ;            size in A.  (that's what comes back from
  10957. ;            the command parser when entering filenames)
  10958. ;            Copies that string into fcb1, terminated
  10959. ;            with an ATEOL.  Returns size in A
  10960. ;
  10961. cmd2fcb:
  10962.     stx    source        ; set source addr
  10963.     sty    source+1    ; ...
  10964.     pha            ; save size so we can return it
  10965.     ldy    #0        ; zero source idx
  10966.     tax            ; get size in x
  10967.     beq    cmd2fcb2    ; if zero left, exit
  10968. cmd2fcb1:
  10969.     lda    (source),y    ; get a byte
  10970.     sta    fcb1,y        ; stuff it in
  10971.     iny            ; bump idx
  10972.     dex            ; dec size
  10973.     bne    cmd2fcb1    ; back for more
  10974. cmd2fcb2:
  10975.     lda    #ATEOL        ; terminate it
  10976.     sta    fcb1,y
  10977.     pla            ; get original size back
  10978.     rts            ; done!
  10979.  
  10980. ;
  10981. ;    Kerflm - fills the buffer pointed to by Kerto with the
  10982. ;    character in kwrk02 for Kwrk01 characters.
  10983. ;
  10984.  
  10985. kerflm:    ldy    kwrk01        ; Get the length of the string
  10986. kerflp:    dey            ; One character less
  10987.     bmi    kerflr        ; If this went negative, we're done
  10988.     lda    kwrk02        ; Get the fill character
  10989.     sta    (kerto),y    ; And put it in the next position
  10990.     jmp    kerflp        ; Go back to do next char
  10991. kerflr:    rts            ; Job is done, return
  10992.  
  10993.  
  10994. ;
  10995. ;    Prchr - takes a character from the AC and prints it. It
  10996. ;    echos control characters as '^<chr>', and wierd atari chars
  10997. ;    in their graphics form.
  10998. ;
  10999.  
  11000. prchr:    pha            ; [jrd] save original
  11001.     and    #$7F        ; [jrd] for testing control-ness
  11002.     cmp    #$20        ; Less than escape??
  11003.     bpl    prchr1        ; If not, continue
  11004.     lda    #'^        ; Load the up-arrow for cntrl characters
  11005.     jsr    cout        ; Print the character
  11006.     pla            ; Get the character back
  11007.     clc            ; Clear carry for add
  11008.     adc    #$40        ; Put this in the alphabetic range
  11009.     jmp    prchr        ; [jrd] tail recurse...
  11010. ;
  11011. prchr1: lda    #esc        ; [jrd] 'quote' it with esc, in case
  11012.                 ;  of nasty screen hacking chars
  11013.     jsr    cout        ; put that
  11014.     pla            ; get original back
  11015.     jmp    cout        ;    and print it
  11016.  
  11017.  
  11018. ;
  11019. ;    Genmad - takes a message base, offset and size and calculates
  11020. ;    the address of the message leaving it in the X and Y registers
  11021. ;    ready for a call to PRSTR. The size and offset are taken from
  11022. ;    the stack and the base address is found in kermbs.
  11023. ;
  11024.  
  11025. genmad: pla            ; Get return address
  11026.     sta    kerrta        ;    and save it till later
  11027.     pla            ;
  11028.     sta    kerrta+1    ;
  11029.     pla            ; Get message offset
  11030.     tax            ; Hold it here for a while
  11031.     pla            ; Get the message length
  11032.     tay            ;    and put it here
  11033.     lda    #0        ; H.O. byte of message offset for mul16
  11034.     pha            ;
  11035.     txa            ; L.O. byte of message offset
  11036.     pha            ;
  11037.     lda    #0        ; H.O. byte of message size for mul16
  11038.     pha            ;
  11039.     tya            ; L.O. byte of message size
  11040.     pha            ;
  11041.     jsr    mul16        ; Calculate the actual offset in table
  11042.     pla            ; Get L.O. byte of result
  11043.     clc            ; Clear the carry for addition
  11044.     adc    kermbs        ; Add the L.O. byte of the base address
  11045.     tax            ; Put it in X for the return
  11046.     pla            ; Get the H.O. byte
  11047.     adc    kermbs+1    ; Add the H.O. byte of the base address w/carry
  11048.     tay            ; Stuff it here for the return
  11049.     lda    kerrta+1    ; Replace the return address on the stack
  11050.     pha            ;        ...
  11051.     lda    kerrta        ;        ...
  11052.     pha            ;        ...
  11053.     rts            ; Return
  11054.  
  11055.  
  11056. .SBTTL     Video Support Routines
  11057.  
  11058. ;
  11059. ;    Prttab - Go to next tab stop
  11060. ;
  11061.  
  11062. prttab:    sec            ;[26] Get the cursor coordinates
  11063.     jsr    ploth        ;[26]        ...
  11064. ;    tya            ;[26] Put the column in A
  11065.     txa            ;[26] Put the column in A
  11066.     lsr    a        ;[26] Divide column by 8
  11067.     lsr    a        ;[26]        ...
  11068.     lsr    a        ;[26]        ...
  11069. ;    tay            ;[26] Add one
  11070.     tax            ;[26] Add one
  11071. ;    iny            ;[26]        ...
  11072.     inx            ;[26]        ...
  11073. ;    tya            ;[26]        ...
  11074.     txa            ;[26]        ...
  11075.     asl    a        ;[26] Multiply by 8
  11076.     asl    a        ;[26]        ...
  11077.     asl    a        ;[26]        ...
  11078. ;    tay            ;[26] Put the new column in Y
  11079.     tax            ;[26] Put the new column in Y
  11080. ;    cpy    #80
  11081.     cpx    #80
  11082.     lda    scrtype
  11083.     bne    prttab1        ;[37]
  11084. ;    cpy    #40        ;[26] Is new column number 40?
  11085.     cpx    #40        ;[26] Is new column number 40?
  11086. prttab1: bcs    prttab2        ; at leftmost edge?
  11087.     jsr    ploth        ; carry already clear
  11088.     rts
  11089. prttab2: jsr    scrcr        ; at leftmost edge. perform a cr and lf
  11090.     jsr    scrlf
  11091.     rts
  11092.  
  11093. ;
  11094. ;    Ploth - Plot the cursor position
  11095. ;
  11096. ;    Input: Carry set to read cursor position
  11097. ;           Y-reg cursor y position            (if carry is set)
  11098. ;           X-reg cursor x position            (if carry is set)
  11099. ;
  11100. ;    Output:Y-reg is cursor y position        (if carry is clear)
  11101. ;           X-reg is cursor x position        (if carry is clear)
  11102. ;
  11103. ;    Registers Destroyed:  None            (if carry is set)
  11104. ;
  11105.  
  11106. ploth:    bcc    ploth1
  11107.     ldy    ROWCRS
  11108.     ldx    COLCRS
  11109.     cpx    #80        ; zzz check 40 col too
  11110.     bcc    ploth0
  11111.     ldx    #79
  11112. ploth0:    clc
  11113.     rts
  11114.  
  11115. ploth1:
  11116. ;    tya            ; swap a-reg and x-reg
  11117. ;    pha
  11118. ;    txa
  11119. ;    tay
  11120. ;    pla
  11121. ;    tax
  11122. ;    jsr    scrplt
  11123.     jmp    scrplt
  11124. ;    rts
  11125.  
  11126. ;    Print (X) spaces
  11127. ; obsolete
  11128. ;prbl2:  stx    savex        ;[DD] Save X
  11129. ;    lda    #sp        ;[DD] Get a space
  11130. ;    jsr    cout        ;[DD] Print it
  11131. ;    ldx    savex        ;[DD] Get back X
  11132. ;    dex            ;[DD] Decrement it
  11133. ;    bne    prbl2        ;[DD] If not 0, do more
  11134. ;    rts            ;[DD] Return
  11135.  
  11136. ; Print a reg as 2 hex nibbles
  11137.  
  11138. prbyte:             ;[DD] Output byte in hex
  11139. by2hx:  pha            ;[DD] Save byte
  11140.     lsr    a        ;[DD]
  11141.     lsr    a        ;[DD]
  11142.     lsr    a        ;[DD]
  11143.     lsr    a        ;[DD]
  11144.     jsr    ny2hx             ;[DD] High nyble
  11145.     tax                 ;[DD] to x
  11146.     pla                 ;[DD] Get back
  11147.     and    #$0F             ;[DD] Low nyble
  11148.     jsr    ny2hx        ;[DD] Translate to Hex
  11149.     pha            ;[DD] Save low nyble
  11150.     txa            ;[DD] Get high nyble
  11151.     jsr    cout        ;[DD] Print it
  11152.     pla            ;[DD] Get back low nyble
  11153.     jmp    cout        ;[DD] Print and return
  11154.  
  11155. ; Translate nyble to hex
  11156.  
  11157. ny2hx:    clc            ;[DD]
  11158.     adc    #$F6        ;[DD]
  11159.     bcc    ny2h2        ;[DD]
  11160.     adc    #6        ;[DD]
  11161. ny2h2:  adc    #$3A        ;[DD]
  11162.     rts            ;[DD]
  11163.  
  11164. ; Print hex of A,X
  11165. ; obsolete 
  11166. ;prntax: stx    savex        ;[DD] Save X
  11167. ;    jsr    prbyte        ;[DD] Print A first
  11168. ;    lda    savex        ;[DD] Get X into A
  11169. ;    jsr    prbyte        ;[DD] Print that next
  11170. ;    rts            ;[DD] Return
  11171.  
  11172. ;    Prntad - Print a number in base 10.  Leading zeros are skipped.
  11173. ;
  11174. ;    Input: A,X - Number to be printed
  11175. ;
  11176. ;    Registers Destroyed:    A,X,Y
  11177. ;
  11178. ;    This routine works by repeated subtraction.  10^X is subtracted
  11179. ;    until the result would be negative.  After each subtraction, Y
  11180. ;    is incremented. Y starts out at '0.  Thus, Y is the ascii value
  11181. ;    of the next digit.
  11182.  
  11183. prntad:
  11184.     stx    decnum        ; [54] Save the number to print
  11185.     sta    decnum+1    ; [54]
  11186.  
  11187.     ldx    #4        ; [54] Up to 5 digits (0..4)
  11188. prntad1: lda    decnum        ; [54] Compare with 10^x
  11189.     cmp    tens1,x        ; [54]
  11190.     lda    decnum+1    ; [54]
  11191.     sbc    tens2,x        ; [54]
  11192.     bcs    prntad2        ; [54] If greater, found first nonzero digit
  11193.     dex            ; [54] Skip the leading zero
  11194.     bne    prntad1        ; [54] Go test the next digit, unless last
  11195.  
  11196. prntad2: ldy    #'0        ; [54] Y is the ascii value to print
  11197. prntad3: lda    decnum        ; [54] Compare with 10^x
  11198.     cmp    tens1,x        ; [54]
  11199.     lda    decnum+1    ; [54]
  11200.     sbc    tens2,x        ; [54]
  11201.     bcc    prntad4        ; [54] Result would be negative.
  11202.  
  11203.     lda    decnum        ; [54] Now subtract 10^x
  11204.     sbc    tens1,x        ; [54] carry is already set
  11205.     sta    decnum        ; [54]
  11206.     lda    decnum+1    ; [54]
  11207.     sbc    tens2,x        ; [54]
  11208.     sta    decnum+1    ; [54]
  11209.     iny            ; [54] Keep track of the value of this digit
  11210.     bne    prntad3        ; [54] Always taken
  11211.  
  11212. prntad4: txa            ; [54] Save X
  11213.     pha            ; [54]
  11214.     tya            ; [54] Print the character in Y
  11215.     jsr    cout        ; [54]
  11216.     pla            ; [54] Restore X
  11217.     tax            ; [54]
  11218.     dex            ; [54] Print the next digit.
  11219.     bpl    prntad2        ; [54]
  11220.     rts
  11221. tens1    .byte    1\,10\,100\,1000\,10000\ ; [54] Powers of ten for prntad
  11222. tens2    .byte    1^,10^,100^,1000^,10000^
  11223.  
  11224. ;
  11225. ;    prntadnl    prntad followed by prcrlf
  11226. ;
  11227. prntadnl:
  11228.     jsr    prntad
  11229.     jmp    prcrlf
  11230.  
  11231. ;
  11232. ;    Cout - Print byte to screen
  11233. ;
  11234. ;    Input:    A - character to be printed
  11235. ;
  11236. ;    Output:
  11237. ;
  11238. ;    Registers Destroyed:    A,X,Y
  11239. ;
  11240.  
  11241. cout:
  11242. ; superceeded by sputch
  11243. ;    jmp    sputch        ; maybe not?
  11244. ;
  11245. ;    sta    source        ; Save A-reg
  11246. ;    pha            ; save A-reg again
  11247. ;    txa
  11248. ;    pha            ; save X-reg
  11249. ;    tya
  11250. ;    pha            ; save Y-reg
  11251. ;    lda    source
  11252. ;    jsr    scrput        ; print the character
  11253. ;    pla            ; restore Y-reg
  11254. ;    tay
  11255. ;    pla            ; restore X-reg
  11256. ;    tax
  11257. ;    pla            ; restore A-reg
  11258. ;    rts
  11259.     jmp    scrput        ; why go to all that trouble?
  11260.  
  11261. ;    Rdkey - Read keyboard until a byte appears
  11262. ;
  11263. ;    Input:
  11264. ;
  11265. ;    Output:
  11266. ;
  11267. ;    Registers Destroyed:
  11268. ;
  11269.  
  11270. rdkey:    jsr    getkey        ;[DD] Try and get a keyboard byte
  11271. ;    bne    rdret        ;[DD] None, try again
  11272.     bcc    rdret        ; [jrd] there's one, return it
  11273.     jsr    scrfls
  11274.     jmp    rdkey        ;[]
  11275. rdret:    rts            ;[DD]        ...
  11276.  
  11277. ;
  11278. ;    Getkey - Get byte from keyboard, blink cursor
  11279. ;
  11280. ;    Input:    None
  11281. ;
  11282. ;    Output: Character read in CHAR
  11283. ;        Carry set   -> character read
  11284. ;              clear -> no character read
  11285. ;
  11286. ;    Registers Destroyed: A,X,Y
  11287. ;
  11288.  
  11289. getkey:    lda    CH        ; any keys pending?
  11290.     cmp    #$FF
  11291.     beq    getkey1        ; nope, return 0
  11292. ;    jsr    kgetch        ; get one the old way
  11293.     jsr    kbdget        ; get one the new way
  11294.     bcs    getkey        ; false alarm
  11295. getrt:    sta    char        ;[31] Store it
  11296.     cmp    #0        ; [jrd] set other flags
  11297.     clc
  11298.     rts            ;[DD]        ...
  11299. getkey1: lda    #0        ; return nothing
  11300.     sec
  11301.     rts
  11302. ;
  11303. ;----------------------------------------------------------------
  11304. ;    Bell - flash border color - will be terminated next cursor blink
  11305. ;
  11306. ;    Input:    None
  11307. ;
  11308. ;    Output: None
  11309. ;
  11310. ;    Registers Destroyed: None
  11311. ;
  11312.  
  11313. bell:    pha            ;[EL] Save the AC
  11314. beephi:    lda    #$3A        ;some color or other
  11315.     jmp    beep        ;[33]        ...
  11316. beeplo:    pha            ;[33] Save the AC
  11317.     lda    #$AA        ;a different color
  11318. beep:
  11319. ;
  11320. ; this seems to completely fry POKEY; fucks over serial baud rate
  11321. ;
  11322. ;    sta    AUDF4        ;[EL]        ...
  11323. ;    lda    #$E8        ; Pure tone, medium volume
  11324. ;    sta    AUDC4
  11325. ;    lda    #$0f        ;[EL] Select fast attack, slow decay
  11326. ;    sta    attdec        ;[EL]        ...
  11327. ;    lda    #$12        ;[EL] Select sustain ...
  11328. ;    sta    susrel        ;[EL]        ...
  11329. ;    lda    #6        ;[EL] Select not-too-loud volume
  11330. ;    sta    vol        ;[EL]        ...
  11331. ;    lda    #$21        ;[EL] Select sawtooth wave
  11332. ;    sta    wave        ;[EL]        ...
  11333.     sta    COLOR4        ; flash it
  11334. ;    jsr    rdtim        ; remember when the flash started
  11335.     lda    RTCLOK+2
  11336.     sta    lpcnt        ;[EL]        ...
  11337.     pla            ;[EL] Restore the AC
  11338.     rts            ;[EL] Return
  11339.  
  11340. .SBTTL    RS232 Support Routines
  11341.  
  11342. ;    Debugging code.
  11343. ;
  11344. ;    Dump IOCB if ICSTA < 0
  11345. ;
  11346. dbgstr1: .byte    ATEOL,"RS error ",0
  11347. dbgstr2: .byte    " -> ",0
  11348. debugrs:
  11349.     lda    ICSTA,X        ; get status
  11350.     bpl    dbgrs9        ; positive is ok
  11351.     pha            ; save it temporarily
  11352.     lda    ICCOM,X        ; get op that failed
  11353.     pha            ; save that too
  11354.     ldx    #dbgstr1\    ; print debug msg
  11355.     ldy    #dbgstr1^
  11356.     jsr    prstr
  11357.     pla            ; get op back
  11358.     jsr    prbyte        ; print that
  11359.     ldx    #dbgstr2\    ; print second part of str
  11360.     ldy    #dbgstr2^
  11361.     jsr    prstr
  11362.     pla            ; get err back
  11363.     jsr    prbyte
  11364.     jsr    prcrlf        ; end line
  11365.     ldx    #comchan    ; point at rs232 iocb again
  11366. dbgrs9:    rts            ; and go home
  11367.     
  11368. ;
  11369. ;    Openrsm - Open the channel if it wasn't already
  11370. ;    Openrs - Open the RS-232 Channel
  11371. ;
  11372. ;    Input:    RS232 Parameters in x36ax1,x38ax1
  11373. ;
  11374. ;    Ouput:
  11375. ;
  11376. ;    Registers Destroyed: A
  11377. ;
  11378. openrsm:
  11379.     lda    comopen        ; already open?
  11380.     beq    openrs        ; no, go open it for real
  11381.     rts
  11382. openrs:    
  11383.     jsr    closers        ; close it first
  11384.     ldx    #comchan    ; [jrd] rs232 port iocb
  11385.     lda    #comname\    ; [jrd] name lo
  11386.     sta    ICBAL,X
  11387.     lda    #comname^    ; [jrd] name hi
  11388.     sta    ICBAH,X
  11389.      lda    #$0D        ; [jrd] mode in+out+concurrent
  11390.     sta    ICAX1,X
  11391.     lda    #0
  11392.     sta    ICAX2,X
  11393.     sta    ICBLL,X        ; zap buf len
  11394.     sta    ICBLH,X
  11395.     lda    #OPEN
  11396.     sta    ICCOM,X        ; open please
  11397.     jsr    CIOV        ; do it.
  11398. ;    jsr    debugrs        ; zzz debug
  11399. ;
  11400. ; Action code from that kermit
  11401. ;  CIOV(2, 34, 0, 0, 192+48, 0)
  11402. ;
  11403.     lda    #34        ; xio 34, set cts, dtr etc
  11404.     sta    ICCOM,X
  11405.     lda    #192+48+3    ; DTR on, RTS on, XMT on
  11406.     sta    ICAX1,X
  11407.     lda    #0
  11408. ;    sta    ICBLL,X
  11409. ;    sta    ICBLH,X
  11410.     sta    ICBAL,X
  11411.     sta    ICBAH,X
  11412. ;    sta    ICAX2,X
  11413.     jsr    CIOV
  11414. ;    jsr    debugrs        ; zzz debug
  11415. ;
  11416. ;  CIOV(2, 38, 0, 0, 32+PARITY*5, 0)
  11417. ;
  11418.     lda    #38        ; xio 38, translation and parity
  11419.     sta    ICCOM,X
  11420. ;    lda    #32        ; no translation, no parity
  11421.     lda    x38ax1
  11422.     sta    ICAX1,X
  11423. ;    lda    #0
  11424. ;    sta    ICBLL,X
  11425. ;    sta    ICBLH,X
  11426. ;    sta    ICBAL,X
  11427. ;    sta    ICBAH,X
  11428. ;    sta    ICAX2,X
  11429.     jsr    CIOV
  11430. ;    jsr    debugrs        ; zzz debug
  11431. ;
  11432. ;  CIOV(2, 36, 0, 0, 8+baud, 0)
  11433. ;
  11434.     lda    #36        ; xio 36, baud rate
  11435.     sta    ICCOM,X
  11436.     ldy    baud        ; get baud value
  11437.     lda    bdval,y        ; get real parameter for port
  11438.     sta    ICAX1,X
  11439. ;    lda    #0
  11440. ;    sta    ICBLL,X
  11441. ;    sta    ICBLH,X
  11442. ;    sta    ICBAL,X
  11443. ;    sta    ICBAH,X
  11444. ;    sta    ICAX2,X
  11445.     jsr    CIOV
  11446. ;    jsr    debugrs        ; zzz debug
  11447. ;
  11448. ;  CIOV(2, 40, 0, 0, 0, 0)
  11449. ;
  11450.     lda    #40        ; XIO 40, start concurrent IO
  11451.     sta    ICCOM,X
  11452.     lda    #0
  11453.     sta    ICBLL,X
  11454. ;    sta    ICBLH,X
  11455.     sta    ICBAL,X
  11456. ;    sta    ICBAH,X
  11457. ;    sta    ICAX1,X
  11458.     sta    ICAX2,X
  11459.     lda    #$06        ; use page 6 as iobuf
  11460.     sta    ICBAH,X
  11461.     lda    #$01        ; size 256
  11462.     sta    ICBLH,X
  11463.     lda    #$0D        ; value from 850 man, p62.  must be 0D?,
  11464.     sta    ICAX1,X        ;  or any non-zero?
  11465.     jsr    CIOV
  11466.     jsr    debugrs        ; zzz debug
  11467. ;
  11468.     lda    #1
  11469.     sta    comopen        ; com is now open for business
  11470.     jsr    comsta        ; refresh pending byte count
  11471. ; [jrd]
  11472.  
  11473. ;
  11474. ;    Alocrs - Subroutine - allocate the RS232 buffers
  11475. ;
  11476. ;    Input:    Buffer locations in RSOUT,RSIN
  11477. ;
  11478. ;    Output:
  11479. ;
  11480. ;    Registers Destroyed: A
  11481. ;
  11482.  
  11483. alocrs:
  11484. ; all obsolete ?
  11485. ;    lda    #rsout\        ;[24] Allocate the RS-232 buffers
  11486. ;    sta    robuf        ;[24]        ...
  11487. ;    lda    #rsout&$ff00^    ;[24]        ...
  11488. ;    sta    robuf+1        ;[24]        ...
  11489. ;    lda    #rsin\        ;[24]        ...
  11490. ;    sta    ribuf        ;[24]        ...
  11491. ;    lda    #rsin&$ff00^    ;[24]        ...
  11492. ;    sta    ribuf+1        ;[24]        ...
  11493.     rts            ;[24] Return
  11494.  
  11495. ;
  11496. ; Close comm port.  Added by jrd
  11497. ;
  11498. closers:
  11499.     lda    comopen        ; open?
  11500.     beq    closer9        ; nope, just return
  11501.     lda    #0
  11502.     sta    comopen        ; remember that it's closed
  11503.     sta    compend        ; no more pending
  11504.     sta    compend+1
  11505.     ldx    #comchan
  11506.     jmp    closec        ; just ignore status etc
  11507. closer9:
  11508.     rts
  11509. ;
  11510. ;    comsta - Update status of the comm port
  11511. ;
  11512. ;    updates pending byte count in compend.
  11513. ;    Trashes regs
  11514. ;
  11515. comsta:
  11516.     ldx    #comchan    ; [jrd] rs232 iosb please
  11517.     lda    #STATIS        ; [jrd] status request, returns bytes pending
  11518.     sta    ICCOM,X
  11519.     jsr    CIOV
  11520.     jsr    debugrs        ; zzz debugging
  11521.     lda    DVSTAT        ; get device status
  11522.     sta    comstat        ; save for future reference
  11523.     lda    DVSTAT+1    ; get byte count pending
  11524.     sta    compend
  11525.     lda    DVSTAT+2
  11526.     sta    compend+1
  11527.     lda    comstat        ; now check error bits
  11528.     beq    comsta9        ; none, ok
  11529.     lda    debug        ; oops!  error.  Display it?
  11530.     beq    comsta8        ; nope, just whack pending count
  11531.     ldx    comstm\        ; display the message
  11532.     ldy    comstm^
  11533.     jsr    prstr
  11534.     lda    comstat        ; display the status
  11535.     jsr    prbyte
  11536.     jsr    prcrlf
  11537. comsta8:
  11538.     lda    #0
  11539.     sta    compend        ; force a refresh next time
  11540.     sta    compend+1
  11541. comsta9:
  11542.     rts
  11543. comstm:    .byte    "Com err ",0
  11544. ;
  11545. ;    Getrs - Get byte from rs232 port
  11546. ;
  11547. ;    Input:    
  11548. ;
  11549. ;    Output:    Character read in CHAR
  11550. ;    Z set if character was read
  11551. ;
  11552. ;    Registers Destroyed: A,X,Y
  11553. ;
  11554.  
  11555. getrs:
  11556.     jsr    flowco        ;[24] Do flow control if necessary
  11557.     lda    suspend        ;[24] Is RS-232 reading suspended?
  11558.     bne    getr3        ; Yes, 
  11559. getr2:
  11560.     lda    compend        ; [jrd] anything pending?
  11561.     cmp    #0
  11562.     bne    getr2a        ; yup, go get one
  11563.     lda    compend+1    ; ?
  11564.     cmp    #0
  11565.     bne    getr2a
  11566.     jsr    comsta        ; go see if there's any since we looked
  11567.     lda    compend        ; now check byte count again
  11568.     cmp    #0
  11569.     bne    getr2a
  11570.     lda    compend+1
  11571.     cmp    #0
  11572.     bne    getr2a        ; there's something pending, go get it
  11573.     lda    #$FF        ; bogus value so we can...
  11574.     cmp    #0        ;  return NE
  11575.     rts
  11576. ;
  11577. getr2a:                ; dec pending count
  11578.     lda    compend        ; save it
  11579.     dec    compend        ; dec lo byte
  11580.     cmp    #0        ; was it 0?
  11581.     bne    getr2b        ; no, skip hi byte
  11582.     dec    compend+1    ; yes, dec hi byte
  11583. getr2b:    ldx    #comchan    ; now go read one    
  11584.     jsr    chrin        ; [jrd] get one
  11585.     ldx    wrdsiz        ; get word size value
  11586.     beq    getr2c        ; 8-bit = 0
  11587.     and    #$7F        ; if 7 bit, make sure
  11588. getr2c:
  11589.     sta    char        ;[31] Store it here
  11590.     sty    stat        ; [jrd]
  11591.     jsr    rserrs        ;[33] Check for RS232 errrors
  11592. ; bogus    bne    getr3        ;[33] If error, return no byte
  11593. ;    lda    stat        ;[33] Check stat to see if byte was read
  11594. ;    cmp    #1        ; [jrd] has effect of setting Z if 1
  11595.     lda    #0        ; debugging, always return Z
  11596.     cmp    #0
  11597. getr3:    rts            ;[DD] Return
  11598.  
  11599. ;
  11600. ;    Rserrs - Check for RS232 errors
  11601. ;
  11602. ;    Input:    Status in STAT
  11603. ;
  11604. ;    Output:
  11605. ;
  11606. ;    Registers Destroyed: A
  11607. ;
  11608. ; Atari 850 RS232 error bits that show up in DVSTAT
  11609. ;
  11610. RS850FE    =    $80        ; Framing error
  11611. RS850OE    =    $40        ; Receive overrun
  11612. RS850PE    =    $20        ; Parity error
  11613. RS850OV    =    $10        ; Buffer overflow
  11614. RS850IL    =    $08        ; Illegal option combination
  11615. RS850NR    =    $04        ; Device not ready
  11616. RS850BE    =    $02        ; Data block error, ie 850 didn't xcv right
  11617. RS850CE    =    $01        ; Command error
  11618. ;
  11619. ; corresponding messages.  All 8 bytes, for ease of indexing.
  11620. ;
  11621. rsetxt:
  11622.     .byte    "Framing",0
  11623.     .byte    "Overrun",0
  11624.     .byte    "Parity ",0
  11625.     .byte    "Buf Ofl",0
  11626.     .byte    "Bad Opt",0
  11627.     .byte    "Dev NR ",0
  11628.     .byte    "850 err",0
  11629.     .byte    "Cmd err",0
  11630. ;
  11631. rseokt:    .byte    "RS ok  ",0
  11632. rserrtim: .byte    0
  11633. ;
  11634. rserrs:    lda    comstat        ; [jrd] Get the status from last STATUS call
  11635.     beq    erret        ; no bits set, go home
  11636. ;
  11637. ; Display err in stat line.
  11638. ;
  11639.     ldx    #0        ; error bit number, left to right
  11640. rserrs1:
  11641.     rol    A        ; shift out a bit
  11642.     bcs    rserrs2        ; found one, go display it
  11643.     inx            ; bump count
  11644.     cpx    #7        ; done?
  11645.     bne    rserrs1        ; nope, try again
  11646.     jmp    erret
  11647. rserrs2:
  11648.     txa            ; get errnum into A
  11649.     asl    A
  11650.     asl    A
  11651.     asl    A        ; * 8
  11652. ; zzz fix this to work with atari screen, too
  11653.     clc
  11654.     adc    #rsetxt\    ; add base of err msgs
  11655.     pha            ; save for a bit
  11656.     lda    #rsetxt^    ; get hi addr
  11657.     adc    #0        ; add carry
  11658.     tay            ; into Y for statline rtn
  11659.     pla            ; get lo addr back
  11660.     ldx    #32        ; offset in stat line
  11661.     jsr    slput        ; show it
  11662.     jsr    beeplo        ;[33] Error, Feep!
  11663.     lda    RTCLOK+2    ; get time displayed
  11664.     adc    #128        ; set for 2 sec or so
  11665.     ora    #1        ; make sure nonzero
  11666.     sta    rserrtim    ; save it
  11667.     rts            ; done
  11668. erret:
  11669.     lda    rserrtim    ; zero?
  11670.     beq    erret8
  11671. ; this isn't very accurate, but it'll do
  11672.     sbc    RTCLOK+2    ; subtract time value
  11673.     bne    erret9        ; not ready to clear error msg
  11674. erret8:
  11675.     sta    rserrtim    ; zero flag
  11676.     lda    #rseokt\    ; get 'ok' msg
  11677.     ldy    #rseokt^
  11678.     ldx    #32        ; offset in stat line
  11679.     jsr    slput
  11680. erret9:
  11681.     rts            ;[33]
  11682.  
  11683. ;
  11684. ;    Flowco - perform RS-232 flow control
  11685. ;
  11686. ;    Input:
  11687. ;
  11688. ;    Output:
  11689. ;
  11690. ;    Registers Destroyed: A,X
  11691. ;
  11692.  
  11693. flowco:    lda    flowmo        ;[24] Get the flow control mode switch
  11694.     cmp    #on        ;[24] Is it on?
  11695.     bne    flowre        ;[24] No
  11696. ; all this stuff removed cause there's no good way to do it on atari
  11697. ;     lda    shflag        ;[24] Check commodore key
  11698. ;    and    #$02        ;[24] Is it depressed?
  11699. ;    beq    nocomm        ;[24] No
  11700. ;    lda    commflg        ;[24] Was it depressed before
  11701. ;    bne    flowch        ;[24] Yes, ignore it
  11702. ;    inc    commflg        ;[24] Set commodore key flag
  11703.     lda    suspend        ;[24] Currently suspended?
  11704.     beq    flowch        ;[24] No
  11705.     jsr    comsta        ; [jrd] yes, update pending count
  11706. ;    lda    #0        ;[24] Clear suspend flag
  11707. ;    sta    suspend        ;[24]        ...
  11708. ;    beq    flowch        ;[24]
  11709. ;notsus:    inc    suspend        ;[24] Set suspend flag
  11710. ;    bne    flowch        ;[24]
  11711. ;nocomm:    sta    commflg        ;[24] Clear commodore key flag
  11712.  
  11713. flowch:
  11714. ;    lda    ridbe        ;[24] Compute number of chars
  11715. ;    sec            ;[24]    in RS-232 buffer
  11716. ;     sbc    ridbs        ;[24]        ...
  11717. ;    lsr    a        ;[24] Divide count by 2 for accurate check
  11718.     ldx    fxoff        ;[24] Has an xoff already been sent
  11719.     bne    itsoff        ;[24] Yes
  11720.     lda    compend+1    ; more than 256?!?
  11721.     bne    flowch1        ; yup, shut it off
  11722.     lda    compend        ; check lo half
  11723.     bmi    flowch1        ; hi bit set, shut it off    
  11724.     cmp    #50        ;[24] Number chars in buffer reached 50?
  11725.     bcc    flowre        ;[24] No - no flow control necessary yet
  11726. flowch1:
  11727.     jsr    sxoff        ;[24] Send an xoff
  11728.     rts            ;[24] Return
  11729. itsoff: lda    compend+1    ; if > 256, leave it off
  11730.     bne    flowre
  11731.     lda    compend
  11732.     cmp    #20        ;[24] Has backlog dropped to 20 or less?
  11733.     bcs    flowre        ;[24] No - leave input suspended
  11734.     jsr    sxon        ;[24] Send an xon
  11735. flowre:    rts            ;[24] Return
  11736.  
  11737. ;
  11738. ;    Flshin - Flush the RS232 input buffer
  11739. ;
  11740. ;    Input:
  11741. ;
  11742. ;    Output:
  11743. ;
  11744. ;    Registers Destroyed: A
  11745.  
  11746. flshin:    
  11747.     txa            ; save some regs
  11748.     pha
  11749.     tya
  11750.     pha
  11751. flshin1:
  11752.     jsr    getrs        ;[25] Get from RS-232 buffer
  11753.     beq    flshin1        ;[33] No, get more
  11754.     pla
  11755.     tay
  11756.     pla
  11757.     tax
  11758.     rts            ;[25] Yes, finish
  11759.  
  11760. ;
  11761. ;    Putrs - Send byte to RS232
  11762. ;
  11763. ;    Input: Byte in A
  11764. ;
  11765. ;    Output:
  11766. ;
  11767. ;    Registers Destroyed:
  11768. ;
  11769.     .byte    0        ; [jrd] save x 
  11770.     .byte    0        ; [jrd] save y
  11771. putrs:    
  11772.     stx    putrs-2        ; [jrd] save x
  11773.     sty    putrs-1        ; [jrd] save y
  11774.     ldx    #comchan    ; [jrd]
  11775.     jsr    chrout        ;[DD] Send the character
  11776.     ldx    putrs-2        ; [jrd] get x back
  11777.     ldy    putrs-1        ; [jrd]  "  y
  11778.     rts            ;[DD] Return
  11779.  
  11780.  
  11781. ;
  11782. ;    Sbreak - Send a break signal
  11783. ;
  11784.  
  11785. sbreak:    jsr    closers        ; yes, we must
  11786.     ldx    #comchan
  11787.     lda    #192+48+2    ; DTR on, RTS on, XMT off
  11788.     sta    ICAX1,X
  11789.     lda    #34        ; xio 34, set cts, dtr etc
  11790.     sta    ICCOM,X
  11791.     lda    #comname\    ; [jrd] name lo
  11792.     sta    ICBAL,X
  11793.     lda    #comname^    ; [jrd] name hi
  11794.     sta    ICBAH,X
  11795.     lda    #0
  11796.     sta    ICAX2,X
  11797.     jsr    CIOV        ; go do it
  11798.     ldy    #250        ;[DD][28] Delay 250 ms.
  11799. sbdl1:  ldx    #250        ;[DD]        ...
  11800. sbdl2:  dex            ;[DD] Inner loop 1 ms.
  11801.     bne    sbdl2        ;[DD]        ...
  11802.     dey            ;[DD] Outer loop
  11803.     bne    sbdl1        ;[DD]        ...
  11804.     jsr    openrs        ; re open it
  11805.  
  11806. ;
  11807. ; diddle the state of the xmit line.  Expects A to contain
  11808. ; 2 for send-space, 3 for send-mark.
  11809. ;
  11810. hacktx:    jmp    CIOV
  11811.  
  11812. ;
  11813. ;    Subroutine - send out ^Q (xon) to remote host
  11814. ;
  11815.  
  11816. sxon:    lda    #0        ;[24] Clear xoff flag
  11817.     sta    fxoff        ;[24]        ...
  11818.     lda    #$11        ;[24] Transmit ^Q
  11819.     bne    xcom        ;[24]        ...
  11820.  
  11821. ;
  11822. ;    Subroutine - send out ^S (xoff) to remote host
  11823. ;
  11824.  
  11825. sxoff:    lda    #5        ;[24] Set xoff flag
  11826.     sta    fxoff        ;[24][32]    ...
  11827.     lda    #$13        ;[24]    then, transmit ^S
  11828. xcom:    jsr    putrs        ;[24]        ...
  11829.     jsr    updstat        ; [jrd] clean stat line
  11830.     rts            ;[24] Return
  11831.  
  11832. ;
  11833. ;
  11834. ;   Cva2s - Convert ASCII to Speedscript (word processor)
  11835. ;
  11836. ;    Input:    Character in KERCHR
  11837. ;
  11838. ;    Output:    Converted character in KERCHR
  11839. ;
  11840. ;    Registers Destroyed: A
  11841. ;
  11842. ; None of this appears to be necessary on Ataris -- jrd
  11843. ; 
  11844. ;cva2s:  lda    kerchr        ;[DD]
  11845. ;    and    #$7F        ;[DD]
  11846. ;    cmp    #cr        ;[DD]
  11847. ;    bne    cva2s1      ;[DD] Check cr
  11848. ;    lda    #$1F        ;[DD]
  11849. ;cva2s1: cmp    #$61        ;[DD]
  11850. ;    bcc    cva2s2        ;[DD]
  11851. ;    cmp    #$7B        ;[DD]
  11852. ;    bcs    cva2s2        ;[DD]
  11853. ;    and    #$1F        ;[DD] Convert lower case
  11854. ;cva2s2: cmp    #$5B        ;[DD]
  11855. ;    bcc    cva2s3        ;[DD]
  11856. ;    cmp    #$5F        ;[DD]
  11857. ;    bcs    cva2s3        ;[DD]
  11858. ;    and    #$1F        ;[DD]
  11859. ;cva2s3: sta    kerchr        ;[DD]
  11860. ;    rts            ;[DD]
  11861. ; 
  11862. ;;  Convert Seedscript (word processor) to ASCII
  11863. ; 
  11864. ;cvs2a:  lda    kerchr        ;[DD]
  11865. ;    and    #$7F        ;[DD]
  11866. ;cvs2a1: cmp    #$1B        ;[DD]
  11867. ;    bcs    cvs2a2      ;[DD] If <$1b
  11868. ;    ora    #$60        ;[DD] Convert to lc
  11869. ;cvs2a2: cmp    #$1F        ;[DD]
  11870. ;    bcs    cvs2a3        ;[DD]
  11871. ;    ora    #$40        ;[DD]
  11872. ;cvs2a3: bne    cvs2a4         ;[DD] If =$1f
  11873. ;    lda    #cr        ;[DD] cr
  11874. ;cvs2a4:    sta    kerchr        ;[DD]
  11875. ;    rts            ;[DD]
  11876.  
  11877. .SBTTL    Spar and Rpar routines
  11878.  
  11879. ;
  11880. ;    Spar - This routine loads the data buffer with the init parameters
  11881. ;    requested for this Kermit.
  11882. ;
  11883. ;        Input:  NONE
  11884. ;
  11885. ;        Output: @Kerbf1 - Operational parameters
  11886. ;
  11887. ;        Registers destroyed:    A,Y
  11888. ;
  11889.  
  11890. spar:    ldy    #0        ; Clear Y
  11891.     sty    datind        ; Clear datind
  11892.     lda    rpsiz        ; Fetch receive packet size
  11893.     clc            ; Clear the carry flag
  11894.     adc    #$20        ; Characterize it
  11895.     sta    (kerbf1),y    ; Stuff it in the packet buffer
  11896.     iny            ; Increment the buffer index
  11897.     lda    rtime        ; Get the timeout interval
  11898.     clc            ;        ...
  11899.     adc    #$20        ; Make that a printable character
  11900.     sta    (kerbf1),y    ;    and stuff it in the buffer
  11901.     iny            ; Advance the index
  11902.     lda    rpad        ; Get the amount of padding required
  11903.     clc            ;        ...
  11904.     adc    #$20        ; Make that printable
  11905.     sta    (kerbf1),y    ; Put it in the buffer
  11906.     iny            ; Advance index
  11907.     lda    rpadch        ; Get the padding character expected
  11908.     eor    #$40        ; Controlify it
  11909.     sta    (kerbf1),y    ; And stuff it
  11910.     iny            ; Up the packet buffer index
  11911.     lda    reol        ; Get the end-of-line expected
  11912.     clc            ;        ...
  11913.     adc    #$20        ; Characterize it
  11914.     sta    (kerbf1),y    ; Place that next in the buffer
  11915.     iny            ; Advance the index
  11916.     lda    rquote        ; Get the quote character expected
  11917.     sta    (kerbf1),y    ; Store it as-is last in the buffer
  11918.     iny            ; Advance index
  11919. ;    lda    #'Y        ;  Send 'Y' - I will support 8-bit quoting
  11920. ;    sta    (kerbf1),y    ; Stuff it into the data area
  11921.     lda    ebqmod        ;[30] Get eight-bit quoting
  11922.     cmp    #off        ;[30] Is it off?
  11923.     beq    spar1        ;[30] Yes...say we will do it if HE wants to
  11924. ;    lda    sebq        ;[30] Get eight-bit quote character
  11925.     lda    rebq        ;[jrd] Get RECEIVE eight-bit quote character
  11926.     sta    (kerbf1),y    ;[30] So other Kermit knows we are
  11927.     rts            ;[30]    requesting it
  11928. spar1:    lda    #'Y        ; Send 'Y' - I will support 8-bit quoting
  11929.     sta    (kerbf1),y    ; Stuff it into the data area
  11930.     rts            ;        ...
  11931.  
  11932. ;
  11933. ;
  11934. ;    Rpar - This routine sets operational parameters for the other kermit
  11935. ;    from the init packet data buffer.
  11936. ;
  11937. ;        Input:  @Kerbf1 - Operational parameters
  11938. ;
  11939. ;        Output: Operational parameters set
  11940. ;
  11941. ;        Registers destroyed:    A,Y
  11942. ;
  11943.  
  11944. rpar:    ldy    #0        ; Start the data index at 0!
  11945.     lda    (kerbf1),y    ; Start grabbing data from packet buffer
  11946.     sec            ; Uncharacterize it
  11947.     sbc    #$20        ;        ...
  11948.     sta    spsiz        ; That must be the packet size of other Kermit
  11949.     iny            ; Increment the buffer index
  11950.     lda    (kerbf1),y    ; Get the next item
  11951.     sec            ;        ...
  11952.     sbc    #$20        ; Uncharacterize that
  11953.     sta    stime        ; Other Kermit's timeout interval
  11954.     iny            ; Up the index once again
  11955.     lda    (kerbf1),y    ; Get next char
  11956.     sec            ;        ...
  11957.     sbc    #$20        ; Restore to original value
  11958.     sta    spad        ; This is the amount of padding he wants
  11959.     iny            ; Advnace index
  11960.     lda    (kerbf1),y    ; Next item
  11961.     eor    #$40        ; Uncontrolify this one
  11962.     sta    spadch        ; That is padding character for other Kermit
  11963.     iny            ; Advance index
  11964.     lda    (kerbf1),y    ; Get next item of data
  11965.     cmp    #0        ; If it is equal to zero
  11966.     beq    rpar2        ; Use <cr> as a default
  11967.     jmp    rpar3        ;        ...
  11968. rpar2:  lda    #cr        ; Get value of <cr>
  11969.     sta    seol        ; That will be the eol character
  11970.     jmp    rpar4        ; Continue
  11971. rpar3:  sec            ;        ...
  11972.     sbc    #$20        ; unchar the character
  11973.     sta    seol        ; That is the eol character other Kermit wants
  11974. rpar4:  iny            ; Advance the buffer index
  11975.     lda    (kerbf1),y    ; Get quoting character
  11976.     cmp    #0        ; If that is zero
  11977.     beq    rpar5        ; Use # sign as the quote character
  11978.     jmp    rpar6        ; Otherwise, give him what he wants
  11979. rpar5:  lda    #'#        ; Load # sign
  11980. rpar6:  sta    squote        ; Make that the other Kermit's quote character
  11981.     iny            ; Advance the index
  11982.     lda    pdlen        ; Check the data length to see
  11983.     cmp    #9        ;    if the 8-bit quote is there
  11984.     bmi    rparrt        ; If not, return
  11985.     lda    (kerbf1),y    ; Fetch the 8-bit quote
  11986.     cmp    #'N        ; Is it 'N'
  11987.     beq    rpar8        ; Yes, leave.(he doesn't support 8-bit)
  11988.     cmp    #'Y        ; Does he support 8-bit quoting?
  11989. ;    beq    rpar8        ; If so, leave. (we don't need it.)
  11990.     beq    rpar9        ; [jrd] yes, he supports it, using our 
  11991.                 ;  quote character if we asked.
  11992.     cmp    #'!        ; Now, it should be a real character
  11993.     bmi    rparrt        ;    Check if it is in range.
  11994.     cmp    #'?        ;    If so, we set the 8-bit quote char
  11995.     bmi    rpar7        ;    and set 8-bit quoting on.
  11996.     cmp    #$60        ;    If not, just leave.
  11997.     bmi    rparrt        ;        ...
  11998.     cmp    #del        ;        ...
  11999.     bpl    rparrt        ;        ...
  12000. rpar7:    sta    sebq        ; Stuff the character here
  12001.     lda    #on        ; Set 8-bit quoting on
  12002.     sta    ebqmod        ;        ...
  12003.     rts            ; Return
  12004. rpar8:
  12005.     sta    sebq        ; Make sure this parm is stored
  12006.     lda    #off        ;    AND that 8-bit quoting is off.
  12007.     sta    ebqmod        ;        ...
  12008.     rts
  12009. rpar9:    
  12010.     sta    sebq        ; save it, for now at least...
  12011.     lda    ebqmod        ; did we ask for it?
  12012.     cmp    #off
  12013.     beq    rparrt        ; no, just return.
  12014.     lda    rebq        ; we DID ask, and he agreed.  Get the
  12015.     sta    sebq        ;  char we asked for, and use it.
  12016. rparrt:    rts            ; Return
  12017.  
  12018. ;
  12019. ;
  12020. ;    Nakit - sends a standard NAK packet out to the other Kermit.
  12021. ;
  12022. ;        Input:  NONE
  12023. ;
  12024. ;        Output: NONE
  12025. ;
  12026.  
  12027. nakit:  lda    #0        ; Zero the packet data length
  12028.     sta    pdlen        ;        ...
  12029.     lda    #'N        ; Set up a nak packet type
  12030.     sta    ptype        ;        ...
  12031.     jsr    spak        ; Now, send it
  12032.     rts            ; Return
  12033.  
  12034.  
  12035. .SBTTL    Message text
  12036.  
  12037. versio: .byte    ATEOL
  12038.     .byte    "Atari 800 Kermit v 3.7"
  12039.     .byte    ATEOL
  12040.     .byte    "type ? for help"
  12041.     .byte    0        ; [53]
  12042.  
  12043.  
  12044. .SBTTL    Command tables and help text
  12045.  
  12046. ;
  12047. ; Top level command table.  The two values returned in x,y are a 
  12048. ; vector to the routine that matches the command.
  12049. ;
  12050. kercmd:
  12051. ;    .byte    $10        ;[DD][EL][40][] Table length 
  12052.     .byte    $11        ; Table length with Erase command installed
  12053. ;    .byte    $12        ; Table length with LOG command installed
  12054.     .byte    $03,"bye",0        ;,$1E,$1E
  12055.     .word    bye
  12056.     .byte    $07,"connect",0        ;,$00,$00
  12057.     .word    telnet
  12058.     .byte    $09,"directory",0    ;,$2A,$2A
  12059.     .word    dirst
  12060.     .byte    $05,"erase",0        ;,$33,$33
  12061.     .word    erase
  12062.     .byte    $04,"exit",0        ;,$03,$03
  12063.     .word    quit
  12064.     .byte    $06,"finish",0        ;,$21,$21
  12065.     .word    finish
  12066.     .byte    $03,"get",0        ;,$24,$24
  12067.     .word    getfrs
  12068.     .byte    $04,"help",0        ;,$06,$06
  12069.     .word    help
  12070. ;    .byte    $03,"log",0,0,0        ; not implemented
  12071.     .byte    $04,"quit",0        ;,$0C,$0C
  12072.     .word    quit
  12073.     .byte    $07,"receive",0        ;,$0F,$0F
  12074.     .word    receve
  12075.     .byte    $06,"rename",0        ;,$27,$27
  12076.     .word    rename
  12077.     .byte    $07,"restore",0        ;,$30,$30
  12078.     .word    restst
  12079.     .byte    $04,"save",0        ;,$2D,$2D
  12080.     .word    savst
  12081.     .byte    $04,"send",0        ;,$12,$12
  12082.     .word    send
  12083.     .byte    $03,"set",0        ;,$15,$15
  12084.     .word    setcom
  12085.     .byte    $04,"show",0        ;,$18,$18
  12086.     .word    show
  12087.     .byte    $06,"status",0        ;,$1B,$1B
  12088.     .word    status
  12089.  
  12090. ;
  12091. ; Command table for subcommands of "set".  Returned value 
  12092. ; is jump vector in x,y
  12093. ;
  12094. setcmd:
  12095. ;    .byte    $12        ; Table length with DEFAULT-DISK option in
  12096.     .byte    $11        ; without file-byte-size
  12097.     .byte    $06,"escape",0        ;,$00,$00
  12098.     .word    stesc
  12099.     .byte    $03,"ibm",0        ;,$03,$03        ; 
  12100.     .word    stibm
  12101.     .byte    $0A,"local-echo",0        ;,$06,$06
  12102.     .word    stle
  12103.     .byte    $07,"receive",0        ;,$09,$09
  12104.     .word    strc
  12105.     .byte    $04,"send",0        ;,$0C,$0C
  12106.     .word    stsn
  12107.     .byte    $12,"terminal-emulation",0        ;,$0F,$0F
  12108.     .word    stvt
  12109.     .byte    $0C,"file-warning",0        ;,$12,$12
  12110.     .word    stfw
  12111.     .byte    $11,"eight-bit-quoting",0        ;,$15,$15
  12112.     .word    steb
  12113.     .byte    $09,"debugging",0        ;,$18,$18
  12114.     .word    stdb
  12115.     .byte    $09,"file-type",0        ;,$1B,$1B
  12116.     .word    stmod
  12117. ;    .byte    $0E,"file-byte-size",0        ;,$1E,$1E
  12118. ;    .word    stfbs
  12119.     .byte    $0F,"rs232-registers",0        ;,$21,$21        ;[DD]
  12120.     .word    stccr
  12121.     .byte    $06,"parity",0        ;,$24,$24        ; 
  12122.     .word    stpari
  12123.     .byte    $04,"baud",0        ;,$27,$27        ;[17]
  12124.     .word    stbaud
  12125.     .byte    $09,"word-size",0        ;,$2a,$2a
  12126.     .word    stwrd
  12127.     .byte    $0C,"flow-control",0        ;,$2d,$2d        ;[24]
  12128.     .word    stflow
  12129.     .byte    $0D,"screen-driver",0        ;,$30,$30        ;[37]
  12130.     .word    stscre
  12131.     .byte    $0C,"default-disk",0        ;,$33,$33
  12132.     .word    stdef
  12133.  
  12134. ;    .byte    $05,"color",0,$36,$36
  12135.  
  12136.  
  12137. ;
  12138. ; This one too, values returned are jump vectors
  12139. ;
  12140. shocmd:
  12141. ;    .byte    $12        ; Table length with DEFAULT-DISK opt included
  12142.     .byte    $11        ; without file-byte-size
  12143.     .byte    $03
  12144. shodef:    .byte    "all",0            ;,$00,$00
  12145.     .word    shall
  12146.     .byte    $04,"baud",0        ;,$7e,$7e
  12147.     .word    shbad
  12148.     .byte    $09,"debugging",0        ;,$51,$51
  12149.     .word    shdb
  12150.     .byte    $0C,"default-disk",0        ;,$99,$99
  12151.     .word    shdef
  12152.     .byte    $11,"eight-bit-quoting",0        ;,$48,$48
  12153.     .word    sheb
  12154.     .byte    $06,"escape",0        ;,$09,$09
  12155.     .word    shesc
  12156. ;    .byte    $0E,"file-byte-size",0        ;,$63,$63
  12157. ;    .word    shfbs
  12158.     .byte    $09,"file-type",0        ;,$5A,$5A
  12159.     .word    shmod
  12160.     .byte    $0C,"file-warning",0        ;,$3F,$3F
  12161.     .word    shfw
  12162.     .byte    $0C,"flow-control",0        ;,$90,$90        ;[24]
  12163.     .word    shflow
  12164.     .byte    $03,"ibm",0        ;,$12,$12
  12165.     .word    shibm
  12166.     .byte    $0A,"local-echo",0        ;,$1B,$1B
  12167.     .word    shle
  12168.     .byte    $06,"parity",0        ;,$75,$75
  12169.     .word    shpari
  12170.     .byte    $07,"receive",0        ;,$24,$24
  12171.     .word    shrc
  12172.     .byte    $0F,"rs232-registers",0        ;,$6C,$6C            ;[DD]
  12173.     .word    shccr
  12174.     .byte    $04,"send",0        ;,$2D,$2D
  12175.     .word    shsn
  12176.     .byte    $12,"terminal-emulation",0        ;,$36,$36
  12177.     .word    shvt
  12178.     .byte    $09,"word-size",0        ;,$87,$87            ;[17]
  12179.     .word    shwrd
  12180.  
  12181. stscmd: .byte    $07
  12182.     .byte    $14,"eight-bit-quote-char",0,$06,$06
  12183.     .byte    $0B,"end-of-line",0,$09,$09
  12184.     .byte    $0D,"packet-length",0,$0C,$0C
  12185.     .byte    $08,"pad-char",0,$00,$00
  12186.     .byte    $07,"padding",0,$03,$03
  12187.     .byte    $0A,"quote-char",0,$0F,$0F
  12188.     .byte    $07,"timeout",0,$12,$12
  12189.  
  12190. ftcmd:
  12191. ;    .byte    $04                ; len with 'script' in
  12192.     .byte    3
  12193.     .byte    $07
  12194. ftcdef:    .byte    "atascii",0,ftatas,ftatas        ; defualt
  12195.     .byte    $05,"ascii",0,ftstas,ftstas
  12196.     .byte    $06,"binary",0,ftbin,ftbin
  12197. ;    .byte    $06,"script",0,$03,$03
  12198.  
  12199. parkey:    .byte    $05        ; LENGTH OF THIS TABLE IS 5
  12200.     .byte    $04,"even",0,$04,$04        ;
  12201.     .byte    $04,"mark",0,$02,$02        ;
  12202.     .byte    $04,"none",0,$00,$00        ;
  12203.     .byte    $03,"odd",0,$03,$03        ;
  12204.     .byte    $05,"space",0,$01,$01        ;
  12205.  
  12206. bdkey:    .byte    $0A        ;[17] Length of table
  12207.     .byte    2,"50",0,bd50,bd50
  12208.     .byte    2,"75",0,bd75,bd75
  12209.     .byte    3,"110",0,bd110,bd110
  12210.     .byte    3,"150",0,bd150,bd150
  12211.     .byte    3,"300",0,bd300,bd300
  12212.      .byte    4,"1200",0,bd1200,bd1200
  12213.     .byte    4,"1800",0,bd1800,bd1800
  12214.     .byte    4,"2400",0,bd2400,bd2400
  12215.     .byte    4,"4800",0,bd4800,bd4800
  12216.     .byte    4,"9600",0,bd9600,bd9600 
  12217.  
  12218. debkey:    .byte    $03        ; LENGTH OF THIS TABLE IS 3
  12219.     .byte    $03,"off",0,$00,$00        ;
  12220.     .byte    $05,"terse",0,$01,$01        ;
  12221.     .byte    $07,"verbose",0,$02,$02        ;
  12222.  
  12223. fbskey: .byte    $02
  12224.     .byte    $09,"eight-bit",0,$00,$00
  12225.     .byte    $09,"seven-bit",0,$01,$01
  12226.  
  12227. oncmd:  .byte    $02
  12228.      .byte    $02,"on",0,$01,$01
  12229.      .byte    $03,"off",0,$00,$00
  12230.  
  12231. yescmd: .byte    $02
  12232.     .byte    $02,"no",0,$00,$00
  12233.      .byte    $03,"yes",0,$01,$01
  12234.  
  12235. scrkey:    .byte    $03        ;[37]
  12236.     .byte    $05,"atari",0,scrae,scrae
  12237.     .byte    $0a,"40-columns",0,scr40,scr40
  12238.     .byte    $0a,"80-columns",0,scr80,scr80
  12239.  
  12240. termemu: .byte    $03        ;terminal emulation may be none, vt52 or vt100
  12241.     .byte    4,"none",0,ttnone,ttnone
  12242.     .byte    5,"vt100",0,tt100,tt100
  12243.     .byte    4,"vt52",0,tt52,tt52
  12244.  
  12245. ;ddskey:    .byte    $01
  12246.  
  12247. ;    .byte    $05
  12248. ;    .asciz    /DRIVE/
  12249. ;    .byte    $00,$00
  12250.  
  12251. kerehr:    .byte    cmcfm        ; tell them they can also confirm
  12252.     .byte    nul        ; end help command string
  12253.  
  12254. kereht:    .byte    cmtxt        ;[]
  12255.     .byte    nul
  12256.  
  12257. kerhlp: .byte    ATEOL
  12258.     .byte    "kermit commands for this version are:",ATEOL
  12259.     .byte    ATEOL
  12260.     .byte    "bye       shut  down  and  log  out  a",ATEOL
  12261.     .byte    "          remote  kermit server,  then",ATEOL
  12262.     .byte    "          exit.",ATEOL
  12263.     .byte    ATEOL
  12264.     .byte    "connect   allow user to talk to remote",ATEOL
  12265.     .byte    "          kermit directly.",ATEOL
  12266.     .byte    ATEOL
  12267.     .byte    "directory list disk directory",ATEOL
  12268.     .byte    ATEOL
  12269.     .byte    "rename    renames one or more files on",ATEOL
  12270.     .byte    "          the default drive.",ATEOL
  12271.     .byte    ATEOL
  12272.     .byte    "erase     deletes one or more files on",ATEOL
  12273.     .byte    "          the default drive.",ATEOL
  12274.     .byte    ATEOL
  12275.     .byte    "exit      exit  from  kermit  back  to",ATEOL
  12276.     .byte    "          the  host operating  system.",ATEOL
  12277.     .byte    ATEOL
  12278.     .byte    "finish    shut   down  remote   kermit",ATEOL
  12279.     .byte    "          server  but  do not  log out",ATEOL
  12280.     .byte    "          remote job. do not exit from",ATEOL
  12281.     .byte    "          local kermit.",ATEOL
  12282.     .byte    ATEOL
  12283.     .byte    "get       fetch  a file from a  remote",ATEOL
  12284.     .byte    "          server kermit.  the filename",ATEOL
  12285.     .byte    "          is  validated by  the remote",ATEOL
  12286.     .byte    "          server.",ATEOL
  12287.     .byte    ATEOL
  12288.     .byte    "help      print instructions on",ATEOL
  12289.     .byte    "          various  commands  available",ATEOL
  12290.     .byte    "          in kermit.",ATEOL
  12291.     .byte    ATEOL
  12292.     .byte    "quit      same as exit.",ATEOL
  12293.     .byte    ATEOL
  12294.     .byte    "receive   receive a file or file group",ATEOL
  12295.     .byte    "          from the remote host.",ATEOL
  12296.     .byte    ATEOL
  12297.     .byte    "restore   restore  kermit  parameters",ATEOL
  12298.     .byte    "          from file kermit.ini",ATEOL
  12299.     .byte    ATEOL
  12300.     .byte    "save      save  kermit  parameters in",ATEOL
  12301.     .byte    "          file kermit.ini",ATEOL
  12302.     .byte    ATEOL
  12303.     .byte    "send      sends a file from the  m6502",ATEOL
  12304.     .byte    "          based computer to the remote",ATEOL
  12305.     .byte    "          host.",ATEOL
  12306.     .byte    ATEOL
  12307.     .byte    "set       establish various parameters",ATEOL
  12308.     .byte    "          such as debugging mode,  eol",ATEOL
  12309.     .byte    "          character, and  transmission",ATEOL
  12310.     .byte    "          delay.",ATEOL
  12311.     .byte    ATEOL
  12312.     .byte    "show      display  various  parameters",ATEOL
  12313.     .byte    "          established   by   the   set",ATEOL
  12314.     .byte    "          command.",ATEOL
  12315.     .byte    ATEOL
  12316.     .byte    "status    give  information about  the",ATEOL
  12317.     .byte    "          last file transfer.",ATEOL
  12318.     .byte    nul
  12319.  
  12320. inthlp: .byte    "one of the following:",ATEOL
  12321.     .byte    "     ? - this help message.",ATEOL
  12322.     .byte    "     b - send a break signal.",ATEOL
  12323.     .byte    "     c - close the connection.",ATEOL
  12324.     .byte    "     s - status of connection.",ATEOL
  12325.     .byte    "     escape-char - transmit the escape character.",ATEOL,nul
  12326.  
  12327. .SBTTL    Message Text
  12328.  
  12329. ermes1: .byte    ATEOL,"?unrecognized command",0        ; [53]
  12330. ermes2: .byte    ATEOL,"?illegal character",0        ; [53]
  12331. ermes3: .byte    ATEOL,"?not confirmed",0        ; [53]
  12332. ermes4: .byte    ATEOL,"?integer out of range",0        ; [53]
  12333. ermes5: .byte    ATEOL,"?ascii character is not in proper range",0        ; [53]
  12334. ermes6: .byte    ATEOL,"?expecting keyword",0        ; [53]
  12335. ermes7: .byte    ATEOL,"?expecting file spec",0        ; [53]
  12336. ermes8: .byte    ATEOL,"?expecting integer",0        ; [53]
  12337. ;ermes9: .byte    ATEOL,"?expecting switch",0        ; [jrd] no switches
  12338. ermesa:    .byte    ATEOL,"?",0        ; [53]
  12339. ermesb:    .byte    ATEOL,"?null string found while looking for text",0    ; [53]
  12340. ermesc:    .byte    ATEOL,"?could not send generic logout packet",0        ; [53]
  12341. ermesd:    .byte    ATEOL,"?could not send generic finish packet",0        ; [53]
  12342. ermesf:    .byte    ATEOL,"?drive number out of range",0        ; [53]
  12343.  
  12344. erms0a: .byte    ATEOL,"disk error stat = "
  12345. ermsdc:    .byte    "??",0        ; [53]
  12346. erms10: .byte    ATEOL,"cannot receive init",0        ; [53]
  12347. erms11: .byte    ATEOL,"cannot receive file-head",0        ; [53]
  12348. erms12: .byte    ATEOL,"cannot receive data",0        ; [53]
  12349. erms14: .byte    ATEOL,"max retry count exceeded",0        ; [53]
  12350. erms15: .byte    ATEOL,"bad chksum:pack, actual ",0        ; [53]
  12351. erms16: .byte    ATEOL,"program error in rpak",0        ; [53]
  12352. erms17: .byte    ATEOL,"8-bit quoting refused",0        ; [53]
  12353. erms18: .byte    ATEOL,"transfer aborted by user",0        ; [53]
  12354. erms19: .byte    ATEOL,"cannot alter filename",0        ; [53]
  12355. erms1a: .byte    ATEOL," file already exists",0        ; [53]
  12356.  
  12357. ;
  12358. ; error message vectors, indexed by error numbers
  12359. ;
  12360. kerrv:    .word    0            ; padding
  12361.     .word    erms10            ; errcri 
  12362.     .word    erms11            ; errcrf
  12363.     .word    erms12            ; errcrd
  12364.     .word    erms14            ; errmrc
  12365.     .word    erms15            ; errbch
  12366.     .word    0            ; no internal error msg?
  12367.     .word    erms18            ; errfta
  12368.     .word    erms19            ; errfal
  12369.     .word    erms1a            ; errfae
  12370.     .word    erms0a            ; errfde
  12371. ;
  12372. ; general error code message
  12373. ;
  12374. ermess:    .byte    ATEOL,"Error ",0
  12375. ;
  12376.  
  12377. ; file types
  12378. kerftp: .byte    "ascii  ",0        ; [53]
  12379.     .byte    "atascii",0        ; [53]
  12380.     .byte    "binary ",0        ; [53]
  12381. ;    .byte    "script ",0        ; [53]
  12382.  
  12383. ; parity strings
  12384. kerprs:    .byte    "none ",0        ; [53]
  12385.     .byte    "space",0        ; [53]
  12386.     .byte    "mark ",0        ; [53]
  12387.     .byte    "odd  ",0        ; [53]
  12388.     .byte    "even ",0        ; [53]
  12389. ;
  12390. ; See 850 man pg 54 for these values.  All specify 'No translation'
  12391. ; 
  12392. parval:    .byte    $20        ;[17] None, ignore input, don't change output
  12393.     .byte    $2C        ;[17] Space, clear input, don't change output
  12394.     .byte    $2F        ;[17] Mark, clear input, set output 1
  12395.     .byte    $25        ;[17] Odd, check in odd, set out odd
  12396.     .byte    $2A        ;[17] Even, check in even, set out even
  12397.  
  12398. kerbds:    .byte    "50  ",0        ; [53]
  12399.     .byte    "75  ",0        ; [53]
  12400.     .byte    "110 ",0        ; [53]
  12401.     .byte    "150 ",0        ; [53]
  12402.     .byte    "300 ",0        ; [53]
  12403.     .byte    "1200",0        ; [53]
  12404.     .byte    "1800",0        ; [53]
  12405.     .byte    "2400",0        ; [53]
  12406.     .byte    "4800",0
  12407.     .byte    "9600",0
  12408.  
  12409. bdval:    .byte    $02        ;[17]   50
  12410.     .byte    $04        ;[17]   75
  12411.     .byte    $05        ;[17]  110
  12412.     .byte    $07        ;[17]  150
  12413.     .byte    $08        ;[17]  300 
  12414. bddef:    .byte    $0A        ;[17] 1200
  12415.     .byte    $0B        ;[17] 1800
  12416.     .byte    $0C        ;[17] 2400
  12417.     .byte    $0D        ; [jrd] 4800
  12418.     .byte    $0E        ; [jrd] 9600
  12419.  
  12420. kerdms:    .byte    "off     ",0    ; Debug mode strings
  12421.     .byte    "terse   ",0    ;
  12422.     .byte    "verbose ",0    ;
  12423.  
  12424. kertms:    .byte    "none ",0        ; terminal emulation strings
  12425.     .byte    "vt52 ",0
  12426.     .byte    "vt100",0
  12427.  
  12428. kerrts: .byte    "spak:     sending           - ",0
  12429.     .byte    "spakch:   send complete     - ",0
  12430.     .byte    "rpak:     trying to receive - ",0
  12431.     .byte    "rpkfls:   failed to receive - ",0
  12432.     .byte    "rpkret:   received          - ",0
  12433.     
  12434. debms1: .byte    "additional data",0
  12435. debms2: .byte    "     seq number           ",0
  12436. debms3: .byte    "     number of data chars ",0
  12437. debms4: .byte    "     packet checksum      ",0
  12438. snin01: .byte    "sending ..packet no. ",0
  12439. rcin01: .byte    "waiting ..packet no. ",0
  12440. logrcvm: .byte    ATEOL,"Receiving ",0
  12441. logsndm: .byte    ATEOL,"Sending ",0
  12442. shin00: .byte    "debugging is          ",0
  12443. shin01: .byte    "terminal emulation is ",0
  12444. shin02: .byte    "ibm-mode is           ",0
  12445. shin03: .byte    "local-echo is         ",0
  12446. shin04: .byte    "eight-bit-quoting is  ",0
  12447. shin05: .byte    "file-warning is       ",0
  12448. shin06: .byte    "escape character is   ",0
  12449. shin07: .byte    "send",0
  12450. shin08: .byte    "  eight-bit-quoting char is   ",0
  12451. shin09: .byte    "  end-of-line character is    ",0
  12452. shin10: .byte    "  packet-length is            ",0
  12453. shin11: .byte    "  padding character is        ",0
  12454. shin12: .byte    "  amount of padding is        ",0
  12455. shin13: .byte    "  quote character is          ",0
  12456. shin14: .byte    "  timeout (in seconds) is     ",0
  12457. shin15: .byte    "receive",0
  12458. shin16: .byte    "file-type mode is     ",0
  12459. shin17: .byte    "file-byte-size is     ",0
  12460. shin18: .byte    "rs232 registers =     $",0
  12461. shin19:    .byte    "baud rate is          ",0
  12462. shin20:    .byte    "parity is             ",0
  12463. shin21:    .byte    "word-size is          ",0
  12464. shin22:    .byte    "flow-control is       ",0
  12465. shin23:    .byte    "default-disk is       ",0
  12466.  
  12467. shon:    .byte    "on",0
  12468. shoff:  .byte    "off",0
  12469.  
  12470. shsbit: .byte    "seven-bit",0
  12471. shebit: .byte    "eight-bit",0
  12472.  
  12473. sstrng:    .byte    "sending: ",0
  12474. rstrng:    .byte    "received: ",0
  12475.  
  12476. stin00: .byte    "number of data chars sent is:     ",0
  12477. stin01: .byte    "number of data chars received is: ",0
  12478. stin02: .byte    "total no. of chars sent is:       ",0
  12479. stin03: .byte    "total no. of chars received is:   ",0
  12480. stin04: .byte    "overhead for send packets is:     ",0
  12481. stin05: .byte    "overhead for receive packets is:  ",0
  12482. stin06: .byte    "last error encountered is:        ",0
  12483.  
  12484. inf01a: .byte    "[connecting to host: type ",0
  12485. inf01b: .byte    " c to return]",0
  12486.  
  12487. .SBTTL    General Screen Manipulation Routines
  12488.  
  12489. ;
  12490. ;    These routines perform screen manipulation functions.  The usually
  12491. ;    call a screen driver, but some call lower-level manipulation routines.
  12492. ;
  12493. ;    These routines all turn the cursor off before calling the screen
  12494. ;    driver.
  12495. ;
  12496.  
  12497. ;
  12498. ;    scrini - call the screen drivers initilization code
  12499. ;
  12500. ;    Input:    None
  12501. ;    Output: Assorted screen parameters are set
  12502. ;
  12503. ;    Registers destroyed - A,X,Y
  12504. ;
  12505. ;    This routine initilizes some parameters and calls all of the screen
  12506. ;    drivers initilization code. The drivers should be called
  12507. ;    least_favorite_device first and most_favorite device last.
  12508. ;
  12509.  
  12510. scrini:
  12511.     lda    #0        ; wrap defaults on
  12512.     sta    wrap
  12513. ;    sta    line25        ; the 25th line is a status line
  12514. ;    jsr    scraeini
  12515. ;    jsr    scr40ini
  12516. ;    jsr    scr80ini
  12517.     jsr    scrent        ; enter the most_favorite screen driver
  12518.     rts
  12519.  
  12520. ;
  12521. ;    scrent - start up a screen driver
  12522. ;
  12523. ;    Input:    Screen type in scrtype
  12524. ;    Output: None
  12525. ;
  12526. ;    Registers destroyed - A,X,Y
  12527. ;
  12528. ;    This routine sets some parameters and then calls the screen driver to
  12529. ;    start it and set its parameters.  It then calls scred2 to erase the
  12530. ;    screen.
  12531. ;
  12532.  
  12533. scrent:    
  12534.     lda    #0        ; cursor starts at row 1, column 1
  12535.     sta    COLCRS
  12536.     sta    ROWCRS
  12537.     sta    curstat
  12538.     lda    #1        ; mark cursor flash as aborted
  12539.     sta    curabrt        ; cursor is off but supposed to be on
  12540. ;     jsr    rdtim        ; set cntdown to wait the usual amount of time
  12541.     lda    RTCLOK+2
  12542.     sta    cntdown
  12543.     jsr    scrent1        ; call the screen driver
  12544.     jsr    scrrst        ; reset parameters to normal values
  12545.     jsr    scred2        ; clear entire screen
  12546.     rts            ; all done
  12547.  
  12548. scrent1:
  12549.     ldy    scrtype
  12550.     jsr    case
  12551.     .word    scraeent
  12552.     .word    scr40ent
  12553.     .word    scr80ent
  12554.     rts
  12555.  
  12556. ;
  12557. ;    scrext - exit from the screen driver
  12558. ;
  12559. ;    Input:    Screen type in scrtype
  12560. ;    Output: None
  12561. ;
  12562. ;    Registers destroyed - A,X,Y
  12563. ;
  12564. ;    This routine calls the screen driver to exit.  The hardware is returned
  12565. ;    to the state it was left in before kermit started.
  12566. ;
  12567.  
  12568. scrext:    
  12569.     ldy    scrtype
  12570.     jsr    case
  12571.     .word    scraeext
  12572.     .word    scr40ext
  12573.     .word    scr80ext
  12574.  
  12575. ;
  12576. ;    scrrst - reset the screen parameters to normal values
  12577. ;
  12578. ;    Input:    None
  12579. ;    Output: Assorted parameters changed.
  12580. ;
  12581. ;    Registers destroyed - A
  12582. ;
  12583. ;    This routine sets reverse mode off, flashing off, the scrolling
  12584. ;    region to full size, and many other things
  12585. ;
  12586.  
  12587. scrrst:    lda    #0        ; top of scrolling area is line 1
  12588.     sta    top
  12589.     lda    #23        ; bottom of scrolling area is line 24
  12590.     sta    bot
  12591.     lda    #0
  12592.     sta    underln        ; underline is off
  12593.     sta    reverse        ; reverse is off
  12594.     sta    alternt        ; alternt colors are off
  12595.     sta    flash        ; flashing is disabled
  12596.     jsr    scrsav        ; make these the saved parameters
  12597.     rts            ; all done
  12598.  
  12599. ;
  12600. ;    scrput - put a character on the screen
  12601. ;
  12602. ;    Input:    Character to put in a-reg.
  12603. ;        Screen type in scrtype.
  12604. ;    Output: Screen ram, both color rams, and cursor position are changed.
  12605. ;
  12606. ;    Registers destroyed - A,X,Y
  12607. ;
  12608. ;    Assumption:  All screens are 80 columns, but the first (40 columns)
  12609. ;
  12610. ;    This routine puts a character on the screen.  It advances the cursor
  12611. ;    and scrolls the screen when necessary.  It handels a carriage
  12612. ;    return specially.  It prints a carriage return and line feed
  12613. ;
  12614.  
  12615. scrput:    cmp    #ATEOL        ; is it a carriage return?
  12616.     bne    scrput4        ; no go do usual stuff
  12617.     ldx    scrtype        ; on atari screen?
  12618.     beq    scrput3        ; yup, just go do it
  12619.     jsr    scrcr        ; no.  Do a general purpose ret and lf
  12620.     jsr    scrlf
  12621.     rts
  12622. scrput4:
  12623.     pha            ; save the character to put
  12624.     jsr    scroff        ; cant use screen driver while cursor blinks
  12625.     pla            ; restore the character to put
  12626.     ldy    #39        ; 40 is the funny row in 40 column mode
  12627.     ldx    scrtype        ; are we in 40 column mode?
  12628.     beq    scrput1        ; no.  we have an 80 column screen
  12629.     ldy    #79        ; 80 is the funny row in 80 column modes
  12630. scrput1: cpy    COLCRS        ; are we in the funny column?
  12631.     bcs    scrput2        ; no
  12632.     ldx    wrap        ; are we in wrap mode
  12633.     bne    scrput3        ; no. do not wrap
  12634.     pha            ; save the character to put
  12635.     jsr    scrcr        ; yes. do a carriage return
  12636.     jsr    scrlf        ; and a linefeed
  12637.     pla            ; restore the character to put
  12638. scrput2: jsr    scrput3        ; call the routine to put a character.
  12639. ;    inc    COLCRS
  12640.     rts    
  12641.  
  12642. scrput3: ldy    scrtype        ; call the screen driver
  12643.     jsr    case
  12644.     .word    scraeput
  12645.     .word    scr40put
  12646.     .word    scr80put
  12647.  
  12648. ;
  12649. ;    scrcr - perform a carriage return
  12650. ;
  12651. ;    Input:    Screen type in scrtype.
  12652. ;        Cursor position in COLCRS, ROWCRS
  12653. ;
  12654. ;    Output: New new cursor column in COLCRS.
  12655. ;
  12656. ;    Registers destroyed - A,X,Y
  12657. ;
  12658. ;    This routine performs a carriage return.
  12659. ;
  12660.  
  12661. scrcr:    ldy    ROWCRS
  12662.     ldx    #0        ; put cursor in column zero
  12663.     jsr    scrplt        ; move the cursor there
  12664.     rts            ; all done
  12665.  
  12666. ;
  12667. ;    scrlf - perform a line feed
  12668. ;
  12669. ;    Input:    screen type in scrtype
  12670. ;        cursor column in ROWCRS
  12671. ;        cursor row in COLCRS
  12672. ;    Output: New cursor position in COLCRS, ROWCRS.
  12673. ;
  12674. ;    Registers destroyed - A,X,Y
  12675. ;
  12676. ;    This routine performs a line feed.
  12677. ;
  12678.  
  12679. scrlf:    ldy    ROWCRS        ; check if bottom reached
  12680.     cpy    bot
  12681. ;    bcc    scrlf1        ; yes. scroll screen
  12682.     bne    scrlf1        ; yes. scroll screen
  12683.     jmp    scrind
  12684. scrlf1:    iny
  12685.     ldx    COLCRS
  12686.     jsr    scrplt        ; no. move the cursor down one line.
  12687.     rts
  12688. ;
  12689. ;    scrrlf - perform a reverse line feed with scrolling
  12690. ;
  12691. ;    Input:    Type of screen in scrtype
  12692. ;        Cursor coordinates in COLCRS, ROWCRS
  12693. ;
  12694. ;    Output: None
  12695. ;
  12696. ;    Registers Destroyed: A,X,Y
  12697. ;
  12698. ;    This routine performs a reverse line feed.  The cursor is moved up
  12699. ;    one line.  If the cursor reaches the top of the scrolling area, scrri
  12700. ;    is called to scroll the screen backwards.
  12701. ;
  12702.  
  12703. scrrlf:    ldy    ROWCRS
  12704.     cpy    top
  12705.     beq    scrrlf1        ; reached top of the screen?
  12706.     dey            ; no, just move the cursor up
  12707.     ldx    COLCRS
  12708.     jsr    scrplt
  12709.     rts
  12710. scrrlf1: jsr    scrri        ; yes, at top of screen.  Scroll backwards
  12711.     rts
  12712.  
  12713. ;
  12714. ;    scru - move the cursor up stopping at the top of the screen
  12715. ;
  12716. ;    Input:    Type of screen in scrtype
  12717. ;        Cursor coordinates in COLCRS, ROWCRS
  12718. ;
  12719. ;    Output: None
  12720. ;
  12721. ;    Registers Destroyed: A,X,Y
  12722. ;
  12723. ;    This routine moves the cursor up.  If the cursor reaches the top
  12724. ;    of the screen it stops.
  12725. ;
  12726.  
  12727. scru:    ldy    ROWCRS
  12728.     beq    scru1        ; at top of screen?
  12729.     dey
  12730.     ldx    COLCRS
  12731.     jsr    scrplt        ; move the cursor to its new position
  12732. scru1:    rts
  12733.  
  12734. ;
  12735. ;    scrd - move the cursor down stopping at the bottom of the screen
  12736. ;
  12737. ;    Input:    Type of screen in scrtype
  12738. ;        Cursor coordinates in COLCRS, ROWCRS
  12739. ;
  12740. ;    Output: None
  12741. ;
  12742. ;    Registers Destroyed: A,X,Y
  12743. ;
  12744. ;    This routine moves the cursor down.  If the cursor reaches the bottom
  12745. ;    of the screen it stops.
  12746. ;
  12747.  
  12748. scrd:    ldy    ROWCRS
  12749.     cpy    #23        ; 24th line is at the bottom
  12750.     bcc    scrd1        ; move the cursor if less that 24
  12751.     bne    scrd2        ; do not move the cursor if greater than 24
  12752. scrd1:    iny
  12753.     ldx    COLCRS
  12754.     jsr    scrplt        ; put the cursor at its new position
  12755. scrd2:    rts            ; all done
  12756.  
  12757. ;
  12758. ;    scrl - move the cursor left stopping at the left side of the screen
  12759. ;
  12760. ;    Input:    Type of screen in scrtype
  12761. ;        Cursor coordinates in COLCRS, ROWCRS
  12762. ;
  12763. ;    Output: New cursor coordinates in COLCRS, ROWCRS
  12764. ;
  12765. ;    Registers Destroyed: A,X,Y
  12766. ;
  12767. ;    This routine moves the cursor left.  If the cursor reaches the left
  12768. ;    most side of the display, it stops.
  12769. ;
  12770.  
  12771. scrl:    ldx    COLCRS
  12772.     beq    scrl1        ; at left side of screen?
  12773.     dex
  12774.     ldy    ROWCRS
  12775.     jsr    scrplt        ; move the cursor to its new position
  12776. scrl1:    rts
  12777.  
  12778. ;
  12779. ;    scrr - move the cursor right stopping at the right side of the screen
  12780. ;
  12781. ;    Input:    Type of screen in scrtype
  12782. ;        Cursor coordinates in COLCRS, ROWCRS
  12783. ;
  12784. ;    Output: New cursor coordinates in COLCRS, ROWCRS
  12785. ;
  12786. ;    Registers Destroyed: A,X,Y
  12787. ;
  12788. ;    This routine moves the cursor right.  If the cursor reaches the right
  12789. ;    side of the screen it stops.
  12790. ;
  12791.  
  12792. scrr:    ldx    COLCRS
  12793.     cpx    #40        ; check if past right side
  12794.     lda    scrtype        ; in 40 column mode?
  12795.     beq    scrr1
  12796.     cpx    #80        ; check if past right side
  12797. scrr1:    bcs    scrr2
  12798.     inx            ; move the cursor right
  12799.     ldy    ROWCRS
  12800.     jsr    scrplt        ; move the cursor to its new position
  12801. scrr2:    rts            ; all done
  12802.  
  12803. ;
  12804. ;    scred0 - perform the Erase Display #0 VT100 function
  12805. ;
  12806. ;    Input: Type of screen to erase in scrtype
  12807. ;
  12808. ;    Output: None
  12809. ;
  12810. ;    Registers Destroyed: A,X,Y
  12811. ;
  12812. ;    This routine clears from the cursor position to the end of the screen.
  12813. ;    This routine works in 40 column mode, 80 column mode, or Commodore 128
  12814. ;    mode.
  12815. ;
  12816.  
  12817. scred0:    lda    ROWCRS        ; save the cursor y position
  12818.     pha
  12819.     jsr    screl0        ; erase from the cursor to the line
  12820. scred0c: inc    ROWCRS        ; do the next line
  12821.     lda    ROWCRS
  12822.     cmp    #24        ; on line number 24?
  12823.     bcs    scred0b        ; past line 24?  if so, stop
  12824. scred0a: jsr    screl2        ; erase the entire line
  12825.     jmp    scred0c
  12826. scred0b: pla            ; restore cursor y position
  12827.     sta    ROWCRS
  12828.     rts            ; all done
  12829.  
  12830. ;
  12831. ;    scred1 - perform the Erase Display #2 VT100 function
  12832. ;
  12833. ;    Input: Type of screen to erase in scrtype
  12834. ;
  12835. ;    Output: None
  12836. ;
  12837. ;    Registers Destroyed: A,X,Y
  12838. ;
  12839. ;    This routine clears from the beginning of the screen to the cursor.
  12840. ;    This routine works for 40 column mode, 80 column mode, and commodore
  12841. ;    128 mode.
  12842. ;
  12843.  
  12844. scred1:    lda    ROWCRS        ; save the cursor y position
  12845.     pha
  12846.     lda    #0
  12847.     sta    ROWCRS
  12848. scred1b: pla            ; cursors real position
  12849.     pha            ; keep it on the stack
  12850.     cmp    ROWCRS        ; on last line to erase?
  12851.     beq    scred1a        ; yes, erase it specially
  12852.     jsr    screl2        ; erase the entire line
  12853.     inc    ROWCRS
  12854.     jmp    scred1b
  12855. scred1a: pla            ; restore cursor y position
  12856.     sta    ROWCRS
  12857.     jsr    screl1        ; erase from beginning of line to cursor
  12858.     rts            ; all done
  12859.  
  12860. ;
  12861. ;    scred2 - perform the Erase Display #2 VT100 function (clear screen)
  12862. ;
  12863. ;    Input: Type of screen to erase in scrtype
  12864. ;
  12865. ;    Output: None
  12866. ;
  12867. ;    Registers Destroyed: A,X,Y
  12868. ;
  12869. ;    This routine clears the entire screen in either 40 column mode,
  12870. ;    80 column mode, or c128 mode.  It calls screl2 to do the dirty work.
  12871. ;
  12872.  
  12873. scred2:
  12874.     ldy    scrtype        ; what screen are we clearing?
  12875.     bne    scred2z
  12876.     lda    #ATCLR        ; E:, just tell it to clear
  12877.     jmp    sputch        ;  do this
  12878. scred2z:
  12879.     lda    ROWCRS        ; save the cursor y position
  12880.     pha
  12881.     lda    #0        ; move the cursor to the top
  12882.     sta    ROWCRS
  12883. scred2a: jsr    screl2        ; erase the line
  12884.     inc    ROWCRS        ; do the next line
  12885.     lda    ROWCRS
  12886.     cmp    #24        ; on line number 24?
  12887.     bcs    scred2b        ; yup, done
  12888.     bcc    scred2a        ; not yet.  do another line
  12889. scred2b: pla            ; restore cursor y position
  12890.     sta    ROWCRS
  12891.     rts            ; all done
  12892.  
  12893. ;
  12894. ;    screl0 - Perform the VT100 Erase Line function #0
  12895. ;
  12896. ;    Input:    Line number to erase in ROWCRS
  12897. ;        Screen type in scrtyp
  12898. ;    Output: None
  12899. ;
  12900. ;    Registers destroyed - A,X,Y
  12901. ;
  12902. ;    This routine erases from the cursor to the end of the line
  12903. ;
  12904.  
  12905. screl0:    jsr    scroff        ; cant use screen driver while curosr blinks
  12906.     ldy    scrtype        ; which routine to use
  12907.     jsr    case
  12908.     .word    scraeel0
  12909.     .word    scr40el0
  12910.     .word    scr80el0
  12911.  
  12912. ;
  12913. ;    screl1 - Perform the VT100 Erase Line function #1
  12914. ;
  12915. ;    Input:    Line number to erase in ROWCRS
  12916. ;        Screen type in scrtyp
  12917. ;    Output: None
  12918. ;
  12919. ;    Registers destroyed - A,X,Y
  12920. ;
  12921. ;    This routine erases from the beginning of line to the cursor
  12922. ;
  12923.  
  12924. screl1:    jsr    scroff        ; cant use screen driver while curosr blinks
  12925.     ldy    scrtype        ; which routine to use
  12926.     jsr    case
  12927.     .word    scraeel1
  12928.     .word    scr40el1
  12929.     .word    scr80el1
  12930.  
  12931. ;
  12932. ;    screl2 - Perform the VT100 Erase Line function #2
  12933. ;
  12934. ;    Input:    Line number to erase in ROWCRS
  12935. ;        Type of screen in scrtype
  12936. ;    Output:    None
  12937. ;
  12938. ;    Registers destroyed - A,X,Y
  12939. ;
  12940. ;    This routine erases one line compleatly.
  12941. ;
  12942.  
  12943. screl2:    
  12944.     jsr    scroff        ; cant use screen driver while cursor blinks
  12945.     ldy    scrtype        ; which routine to use to erase
  12946.     jsr    case        ; go to proper routine
  12947.     .word    scraeel2        ; erase one line on 40 column screen
  12948.     .word    scr40el2        ; erase one line on 80 column screen
  12949.     .word    scr80el2        ; abort with much fanfair
  12950.  
  12951. ;
  12952. ;    scrind - perfrom the VT100 index function (Move the screen one line)
  12953. ;
  12954. ;    Input:    Screen type in scrtyp
  12955. ;    Output:    None
  12956. ;
  12957. ;    Registers destroyed - A,X,Y
  12958. ;
  12959. ;    This routine scrolls the screen down one line. It calls either scraeind,
  12960. ;    scr40ind, or scr80ind depending on the screen type.
  12961. ;
  12962.  
  12963. scrind:    jsr    scroff        ; cant use screen driver while cursor blinks
  12964.     ldy    scrtype
  12965.     jsr    case
  12966.     .word    scraeind
  12967.     .word    scr40ind
  12968.     .word    scr80ind
  12969.  
  12970. ;
  12971. ;    scrri - perfrom the VT100 reverse index function (scroll backwards)
  12972. ;
  12973. ;    Input:    Screen type in scrtyp
  12974. ;    Output: Screen and color rams are changed
  12975. ;
  12976. ;    Registers destroyed - A,X,Y
  12977. ;
  12978. ;    This routine scrolls the screen up one line. It calls either scraeri,
  12979. ;    scr40ri, or scr80ri depending on the screen type.
  12980. ;
  12981.  
  12982. scrri:    jsr    scroff        ; cant use screen driver while cursor blinks
  12983.     ldy    scrtype
  12984.     jsr    case
  12985.     .word    scraeri
  12986.     .word    scr40ri
  12987.     .word    scr80ri
  12988.  
  12989. ;
  12990. ;    scrdl - Delete line
  12991. ;
  12992. ;    input:    current line
  12993. ;    output:    current line of display zapped, rest of scrolling region moves up to
  12994. ;        fill
  12995. ;
  12996. ;    zzz should check to make sure inside scroll rgn here
  12997. ;
  12998. scrdl:
  12999.     lda    top        ; get current scrolling rgn top
  13000.     pha            ; save it
  13001.     lda    ROWCRS        ; get current row
  13002.     sta    top        ; make it top of scroll rgn temporarily
  13003.     jsr    scrind        ; do an 'index', squeezing out current line
  13004.     pla            ; get old top back
  13005.     sta    top
  13006.     rts
  13007.  
  13008. ;
  13009. ;    scril - Insert line
  13010. ;
  13011. ;    input:    current line
  13012. ;    output:    Bottom line of scroll rgn zapped, blank line inserted at current
  13013. ;        line
  13014. ;
  13015. ;    zzz should check to make sure inside scroll rgn here
  13016. ;
  13017. scril:
  13018.     lda    top        ; get current scrolling rgn top
  13019.     pha            ; save it
  13020.     lda    ROWCRS        ; get current row
  13021.     sta    top        ; make it top of scroll rgn temporarily
  13022.     jsr    scrri        ; do a 'reverse index', squeezing out bottom line
  13023.     pla            ; get old top back
  13024.     sta    top
  13025.     rts
  13026.     
  13027. ;
  13028. ;    scrsav - save screen attributes and cursor position
  13029. ;
  13030. ;    Input:    screen attributes and cursor position
  13031. ;
  13032. ;    Output:    save1, save2, save3, ... save6
  13033. ;
  13034. ;    This routine saves the screen attributes and cursor position
  13035. ;    
  13036.  
  13037. scrsav:    lda    COLCRS
  13038.     sta    save1
  13039.     lda    ROWCRS
  13040.     sta    save2
  13041.     lda    alternt
  13042.     sta    save3
  13043.     lda    underln
  13044.     sta    save4
  13045.     lda    flash
  13046.     sta    save5
  13047.     lda    reverse
  13048.     sta    save6
  13049.     rts
  13050.  
  13051. ;
  13052. ;    scrlod - load the saved screen attributes and cursor position
  13053. ;
  13054. ;    Input:    save1, save2, save3, ... save6
  13055. ;
  13056. ;    This routine restores the saved screen attributes and cursor position
  13057. ;
  13058.  
  13059. scrlod:    ldx    save1
  13060.     ldy    save2
  13061.     jsr    scrplt
  13062.     lda    save3
  13063.     sta    alternt
  13064.     lda    save4
  13065.     sta    underln
  13066.     lda    save5
  13067.     sta    flash
  13068.     lda    save6
  13069.     sta    reverse
  13070.     rts
  13071.  
  13072. ;
  13073. ;    scrplt - plot the cursor
  13074. ;
  13075. ;    Input:    Cursor X position in X-reg
  13076. ;        Cursor Y position in Y-reg
  13077. ;
  13078. ;    Output: COLCRS and ROWCRS are set.
  13079. ;
  13080. ;    Registers destroyed - A,X,Y
  13081. ;
  13082. ;    This routine puts the cursor at X,Y.  It checks to make sure the
  13083. ;    cursor is being moved to a valid location before it moves the cursor.
  13084. ;
  13085.  
  13086. scrplt:
  13087.     cpy    #24        ; cant be greater than or equal to 24
  13088.     bmi    scrplt1        ; oops.  it was
  13089.     ldy    #23        ; ok, make it 23
  13090. scrplt1:
  13091.     cpy    #0        ; better be >= 0
  13092.     bpl    scrplt2
  13093.     ldy    #0
  13094. scrplt2:
  13095. ;
  13096. ; kludge.  Because of the way the auto wrap stuff works, we have to
  13097. ; allow the column to get to 80 (40)
  13098. ;
  13099.     cpx    #41        ; cant be greater than or equal to 40...
  13100.     lda    scrtype        ; ... in 40 column mode
  13101.     beq    scrplt4
  13102.     cpx    #81        ; compare with 80 if not in 40 column mode
  13103. scrplt4:
  13104.     bcs    scrplt9        ; oops.  Greater than the current margin
  13105.     tya            ; save the new y position    
  13106.     pha
  13107.     txa            ; save the new x position
  13108.     pha        
  13109.     jsr    scroff        ; turn off the cursor
  13110.     pla            ; get the new x position
  13111.     sta    COLCRS
  13112.     pla            ; get the new y position
  13113.     sta    ROWCRS
  13114. scrplt9: rts            ; all done
  13115.  
  13116. ;
  13117. ;    scroff - disable the cursor.
  13118. ;
  13119. ;    Input:    COLCRS, ROWCRS, curstat, curabrt, scrtype
  13120. ;
  13121. ;    Output: curabrt
  13122. ;
  13123. ;    Registers destroyed - A,X,Y
  13124. ;
  13125. ;    This routine disables the cursor.  It calls the proper screen driver
  13126. ;    to do the dirty work.
  13127. ;
  13128.  
  13129. scroff:    lda    curabrt        ; is the cursor flash already aborted?
  13130.     bne    scroff1        ; yes.
  13131.     lda    curstat        ; cursor light?
  13132.     beq    scroff1        ; yes.
  13133.     sta    curabrt        ; mark cursor flash as aborted
  13134.     jsr    scrtgl        ; toggle the cursor
  13135. scroff1: rts            ; all done
  13136.  
  13137. ;
  13138. ;    scrfls - flash the screen and cursor
  13139. ;
  13140. ;    Input:    curstat - status of cursor (light or dark)
  13141. ;        curabrt - flag indicating if cursor flash was aborted early.
  13142. ;        scrtype - type of screen
  13143. ;
  13144. ;    Output: curstat - curstat is toggled if time
  13145. ;        curabrt - curabrt is always cleared
  13146. ;
  13147. ;    Registers destroyed - A,X,Y
  13148. ;
  13149. ;    This routine flashes the screen and toggles the cursor.  It also
  13150. ;    stops the sound of the bell 6 jiffys after it started.  This routine
  13151. ;    should be called a frequently as possible.
  13152. ;
  13153.  
  13154. scrfls:    lda    curabrt        ; was the cursor flash aborted early?
  13155.     beq    scrfls1        ; no.  No need to light it.
  13156.     jsr    scrtgl        ; toggle the cursor
  13157.     lda    #0        ; clear the abort flag
  13158.     sta    curabrt
  13159. scrfls1: 
  13160. ;     jsr    rdtim        ; check the time 
  13161.     lda    RTCLOK+2    ; [jrd] get lo order time value
  13162.     tay            ; save the time for later use
  13163.     sec
  13164.     sbc    lpcnt        ; subtract the time the bell started
  13165.     cmp    #6        ; been 6 jiffys since it started?
  13166.     bcc    scrfls3        ; nope.  Dont stop the bell yet
  13167. ;
  13168. ; This screws up POKEY
  13169. ;
  13170. ;    lda    #0
  13171. ;    sta    AUDC4        ; stop the bell
  13172.     lda    bordclr        ; unflash the border
  13173.     sta    COLOR4
  13174. scrfls3: tya            ; check timer value again
  13175.     sec
  13176.     sbc    cntdown
  13177.     cmp    #20        ; have  36 jiffies elapsed?
  13178.     bcs    scrfls2        ; yes they have
  13179.     rts            ; no they havent.  stop here
  13180. scrfls2: sty    cntdown        ; reset the countdown timerldy    
  13181.     jsr    scrtgl        ; toggle the cursor status
  13182.     ldy    scrtype        ; flash the flashing characters
  13183.     jsr    case
  13184.     .word    scraefls
  13185.     .word    scr40fls
  13186.     .word    scr80fls
  13187.  
  13188. ;
  13189. ;    scrtgl - Toggle the cursor
  13190. ;
  13191. ;    Input:    COLCRS - x coordinate of cursor
  13192. ;        ROWCRS - y coordinate of cursor
  13193. ;        Type of screen in scrtype
  13194. ;
  13195. ;    Output: None
  13196. ;
  13197. ;    Registers destroyed - A,X,Y
  13198. ;
  13199. ;    this routine calls the screen driver to toggle the cursor
  13200. ;
  13201.  
  13202. scrtgl:    lda    curstat        ; keep track if cursor is dark or light
  13203.     eor    #$01
  13204.     sta    curstat
  13205.     ldy    scrtype        ; call the screen driver
  13206.     jsr    case
  13207.     .word    scraetgl
  13208.     .word    scr40tgl
  13209.     .word    scr80tgl
  13210.  
  13211.  
  13212. .SBTTL    80 Column screen driver
  13213.  
  13214. ;
  13215. ;    These routines manipulate the screen in 80 column mode.
  13216. ;
  13217.  
  13218. ;
  13219. ;    scr40ini - initilize 40/80 column screen during powerup
  13220. ;
  13221. ;    Input:    None
  13222. ;    Output: scrtype set to use 80 columns
  13223. ;
  13224. ;    Registers destroyed - A
  13225. ;
  13226. ;    This routine does all of the powerup initilization necessary for
  13227. ;    80 columns that was not done in scraeini, and sets the screen type
  13228. ;    to 80 columns.
  13229. ;
  13230.  
  13231. scr40ini:
  13232.     lda    #scr40
  13233.     sta    scrtype
  13234.     rts
  13235.  
  13236. ;
  13237. ;    scr40ent - enter the 40/80 column screen driver
  13238. ;
  13239. ;    Input:    None
  13240. ;
  13241. ;    Output: None
  13242. ;
  13243. ;    Registers destroyed - A,X,Y
  13244. ;
  13245. ;    This routine starts the 40/80 column screen driver.
  13246. ;    well, sort of.  set the display list to point to ours, and build font40
  13247. ;
  13248.  
  13249. scr40ent:
  13250.     jsr    makedl40
  13251.     lda    scr40dl
  13252.     ldy    scr40dl+1
  13253.     jsr    setdlist
  13254.     lda    #scr40        ; we're now in 40/80 mode
  13255.     sta    scrtype
  13256. ;
  13257. ; now make up the font we want.  Copy the builtin one, and stuff in
  13258. ; braces, tilde, graphics
  13259. ;
  13260.     ldy    #0        ; zero the y-reg
  13261.     ldx    newchar,y    ; number of characters defined in this chunk
  13262. scr40ent1: iny
  13263.     lda    newchar,y    ; source of characters (lo order)
  13264.     sta    source
  13265.     iny
  13266.     lda    newchar,y    ; source of characters (hi order)
  13267.     sta    source+1
  13268.     iny
  13269.     lda    newchar,y    ; destination of characters (lo order)
  13270.     sta    dest
  13271.     iny
  13272.     lda    newchar,y    ; destination of characters (hi order)
  13273.     sta    dest+1
  13274.     iny
  13275.     tya            ; save y-reg across call to move8
  13276.     pha
  13277.     jsr    move8
  13278.     pla            ; restore y-reg
  13279.     tay
  13280.     ldx    newchar,y    ; number of characters in this chunk (0=end)
  13281.     bne    scr40ent1    ; loop until done
  13282.     lda    #font40^    ; now point CTIA at it
  13283.     sta    CHBAS
  13284.     rts
  13285.  
  13286. ;
  13287. ;    Newchar - character mapping table
  13288. ;
  13289. ;    This table is used to define the 40 column character set
  13290. ;    The format of this table is:
  13291. ;        Number of characters to copy    (byte)
  13292. ;        Source of characters        (word)
  13293. ;        Destination for characters    (word)
  13294. ;
  13295. newchar:
  13296.     .byte    128        ; the whole thing
  13297.     .word    $E000        ; atari builtin font
  13298.     .word    font40        ; our font table
  13299. ;
  13300. ; graphics characters
  13301. ;
  13302.     .byte    1
  13303.     .word    $E000+<84*8>    ; blot
  13304.     .word    font40+<64*8>
  13305.  
  13306.     .byte    9
  13307.     .word    charg97        ; square blot .. vt
  13308.     .word    font40+<65*8>
  13309.  
  13310.     .byte    2        ; 2 more chars
  13311.     .word    charg111    ;  for scan 1, scan3
  13312.     .word    font40+<79*8>
  13313.  
  13314.     .byte    2        ; and 2 more
  13315.     .word    charg114    ;  for scan 7, 9
  13316.     .word    font40+<82*8>
  13317.  
  13318.     .byte    1
  13319.     .word    $E000+<67*8>    ; down right corner
  13320.     .word    font40+<74*8>
  13321.  
  13322.     .byte    1
  13323.     .word    $E000+<69*8>    ; up right corner
  13324.     .word    font40+<75*8>
  13325.  
  13326.     .byte    1
  13327.     .word    $E000+<81*8>    ; up left
  13328.     .word    font40+<76*8>
  13329.  
  13330.     .byte    1
  13331.     .word    $E000+<90*8>    ; down left
  13332.     .word    font40+<77*8>
  13333.  
  13334.     .byte    1
  13335.     .word    $E000+<83*8>    ; center cross
  13336.     .word    font40+<78*8>
  13337.  
  13338.     .byte    1
  13339.     .word    $E000+<82*8>    ; scan 5
  13340.     .word    font40+<81*8>
  13341.  
  13342.     .byte    1
  13343.     .word    $E000+<124*8>    ; vert bar
  13344.     .word    font40+<88*8>
  13345.  
  13346.     .byte    1
  13347.     .word    $E000+<65*8>    ; left t
  13348.     .word    font40+<84*8>
  13349.  
  13350.     .byte    1
  13351.     .word    $E000+<68*8>    ; right t
  13352.     .word    font40+<85*8>
  13353.  
  13354.     .byte    1
  13355.     .word    $E000+<88*8>    ; bot t
  13356.     .word    font40+<86*8>
  13357.  
  13358.     .byte    1
  13359.     .word    $E000+<87*8>    ; top t
  13360.     .word    font40+<87*8>
  13361.  
  13362.  
  13363. ; more later zzz
  13364.     .byte    4        ; { | } ~
  13365.     .word    char123
  13366.     .word    font40+<123*8>
  13367.  
  13368.     .byte 0        ; end of table
  13369.  
  13370. ;
  13371. ;    charXXX - 40 column character definitions not available in rom
  13372. ;
  13373. ; 
  13374. charg97:
  13375.     .byte    $CC,$CC,$33,$33,$CC,$CC,$33,$33    ; square blot
  13376.     .byte    $90,$90,$F0,$90,$8E,$08,$08,$08    ; h/t
  13377.     .byte    $F0,$80,$E0,$9E,$90,$1C,$10,$10    ; f/f
  13378.     .byte    $30,$40,$40,$3C,$12,$12,$1C,$12    ; c/r
  13379.     .byte    $40,$40,$40,$7E,$10,$1C,$10,$10    ; l/f
  13380.     .byte    $18,$24,$24,$18,$00,$00,$00,$00    ; degrees
  13381.     .byte    $08,$08,$3E,$08,$08,$00,$3E,$00    ; plus/minus
  13382.     .byte    $48,$68,$58,$48,$40,$08,$0E,$00    ; n/l
  13383.     .byte    $44,$44,$28,$10,$3E,$08,$08,$08    ; v/t
  13384. charg111:
  13385.     .byte    $FF,$FF,$00,$00,$00,$00,$00,$00    ; scan 1
  13386.     .byte    $00,$FF,$FF,$00,$00,$00,$00,$00    ; scan 3
  13387. charg114:
  13388.     .byte    $00,$00,$00,$00,$00,$FF,$FF,$00    ; scan 7
  13389.     .byte    $00,$00,$00,$00,$00,$00,$FF,$FF    ; scan 9
  13390.  
  13391. char123:
  13392.     .byte    $0E,$18,$18,$78,$18,$18,$0E,$00    ; {
  13393.     .byte    $18,$18,$18,$18,$18,$18,$18,$00 ; |
  13394.     .byte    $70,$18,$18,$1E,$18,$18,$70,$00    ; }
  13395.     .byte    $00,$00,$3B,$6E,$00,$00,$00,$00    ; ~
  13396.  
  13397. ;
  13398. ;    scr40ext - exit the 80 column screen driver
  13399. ;
  13400. ;    Input:    None
  13401. ;    Output: None
  13402. ;
  13403. ;    Registers destroyed - A,X,Y
  13404. ;
  13405. ;    This routine exits the 40/80 column screen driver.
  13406. ;    for now, just use the E: one
  13407. ;
  13408.  
  13409. scr40ext:
  13410.     lda    #$E0        ; put font pointer back
  13411.     sta    CHBAS
  13412.     jmp    scraeent
  13413.  
  13414. ;
  13415. ;    scr40put - put a character at COLCRS, ROWCRS
  13416. ;
  13417. ;    Input:    character to put in a-reg (use funny ascii)
  13418. ;    Output: None
  13419. ;
  13420. ;    Registers destroyed - A,X,Y
  13421. ;
  13422. ;    This routine puts a character at screen position COLCRS,ROWCRS.  
  13423. ;    This routine does advance the cursor position.
  13424. ;
  13425. scr40put:
  13426.     pha            ; save the char code
  13427.     ldx    COLCRS        ; get col nbr
  13428.     ldy    ROWCRS        ; and row nbr
  13429.     jsr    scr40adrt    ; figure out character address
  13430.     pla            ; get the char back
  13431.     cmp    #$60        ; lower case?
  13432.     bcc    scr40p0        ; (blt) no, offset it
  13433. ;
  13434. ; handle graphics if necessary.  Look at the char set designator
  13435. ; in either csg0 or csg1 (if altcs is set).  If it's csgraf, sub
  13436. ; $20 from the char, to get graphics.  If it's csascii, leave the
  13437. ; char alone.
  13438. ;
  13439.     ldx    csg0        ; assume g0 for starters
  13440.     ldy    altcs        ; alt char set?
  13441.     beq    scr40px        ; no, use this one
  13442.     ldx    csg1        ; ok, use the alt one
  13443. scr40px:
  13444.     cpx    #csascii    ; ascii font?
  13445.     beq    scr40p1        ; yes, leave lc char the way it is
  13446. scr40p0:
  13447.     sec
  13448.     sbc    #$20        ; compensate for atari font layout
  13449. scr40p1:
  13450.     ldy    reverse        ; reverse vid?
  13451.     beq    scr40p2        ; nope, go ahead
  13452.     ora    #$80        ; or in hi bit for reverse vid.
  13453. scr40p2:
  13454.     ldy    #0
  13455.     sta    (dest),y    ; and shove it in screen mem
  13456.     inc    COLCRS        ; bump column
  13457.     jmp    scr40pan    ; and go make sure we're visible
  13458.  
  13459. ;
  13460. ;    Scrpan        call scr40pan if necessary
  13461. ;
  13462. scrpan:
  13463.     lda    scrtype        ; what do we have here?
  13464.     cmp    #scr40        ; 40 col pannable?
  13465.     beq    scr40pan    ; yup, go do it
  13466.     rts
  13467. ;
  13468. ;    Scr40pan    make the current cursor pos visible by
  13469. ;    panning left or right as needed
  13470. ;
  13471. scr40pan:
  13472.     lda    COLCRS        ; pan to make this column visible
  13473.     sec
  13474.     sbc    panval        ; subtract current pan value
  13475. ;
  13476. ; want adjusted (visible) column between 2 and 37, if possible
  13477. ;
  13478.     bmi    scr40pl        ; neg, pan left
  13479.     cmp    #2        ; < 2?
  13480.     bpl    scr40pr        ; nope, try right side
  13481. scr40pl:
  13482.     lda    COLCRS        ; yes, get real col
  13483.     sec
  13484.     sbc    #2        ; - 2
  13485.     jmp    scr40p4        ; and try to pan to there.
  13486. scr40pr:
  13487.     cmp    #37        ; > 37?
  13488.     bmi    scr40p9        ; nope, we're ok.  return
  13489.     lda    COLCRS        ; get real col
  13490.     sec
  13491.     sbc    #37        ; - 37
  13492.     jmp    scr40p5        ; and try to pan to there.
  13493. scr40p4:
  13494.     cmp    #0        ; only left to zero, please
  13495.     bpl    scr40p5
  13496.     lda    #0
  13497. scr40p5:
  13498.     cmp    #40        ; better be less...
  13499.     bmi    scr40p6        ; it is, ok
  13500.     lda    #40        ; max at 40
  13501. scr40p6:
  13502.     sta    panval
  13503.     jsr    pan40        ; make it happen
  13504. scr40p9:
  13505.     rts
  13506. ;
  13507. ;    Font80 - Character definitions
  13508. ;
  13509. ;    this defines the shape of the characters in 80 column mode
  13510. ;    this table is in ascii sequence, offset by $20, ei 'space' is
  13511. ;    the first thing here.  Graphics chars for VT100 line drawing
  13512. ;    mode are the last 32 chars worth.
  13513. ;
  13514. font80:
  13515.     .byte    $00,$00,$00,$00,$00,$00,$00,$00    ;    ' '
  13516.     .byte    $00,$44,$44,$44,$44,$00,$44,$00    ;    '!'
  13517.     .byte    $00,$AA,$AA,$00,$00,$00,$00,$00    ;    '"'
  13518.     .byte    $00,$AA,$EE,$AA,$EE,$AA,$00,$00    ;    '#'
  13519.     .byte    $44,$66,$88,$44,$22,$EE,$44,$00    ;    '$'
  13520.     .byte    $00,$99,$AA,$22,$55,$99,$00,$00    ;    '%'
  13521.     .byte    $00,$44,$AA,$44,$AA,$AA,$55,$00    ;    '&'
  13522.     .byte    $00,$22,$44,$00,$00,$00,$00,$00    ;    '''
  13523.     .byte    $00,$22,$44,$44,$44,$44,$22,$00    ;    '('
  13524.     .byte    $00,$44,$22,$22,$22,$22,$44,$00    ;    ')'
  13525.     .byte    $00,$99,$66,$FF,$66,$99,$00,$00    ;    '*'
  13526.     .byte    $00,$00,$44,$EE,$44,$00,$00,$00    ;    '+'
  13527.     .byte    $00,$00,$00,$00,$00,$22,$22,$44    ;    ','
  13528.     .byte    $00,$00,$00,$EE,$00,$00,$00,$00    ;    '-'
  13529.     .byte    $00,$00,$00,$00,$00,$00,$44,$00    ;    '.'
  13530.     .byte    $00,$22,$22,$44,$44,$88,$88,$00    ;    '/'
  13531.     .byte    $00,$44,$AA,$EE,$AA,$AA,$44,$00    ;    '0'
  13532.     .byte    $00,$44,$CC,$44,$44,$44,$EE,$00    ;    '1'
  13533.     .byte    $00,$44,$AA,$22,$44,$88,$EE,$00    ;    '2'
  13534.     .byte    $00,$EE,$22,$44,$22,$22,$CC,$00    ;    '3'
  13535.     .byte    $00,$AA,$AA,$AA,$EE,$22,$22,$00    ;    '4'
  13536.     .byte    $00,$EE,$88,$CC,$22,$22,$CC,$00    ;    '5'
  13537.     .byte    $00,$44,$88,$CC,$AA,$AA,$44,$00    ;    '6'
  13538.     .byte    $00,$EE,$22,$22,$44,$88,$88,$00    ;    '7'
  13539.     .byte    $00,$44,$AA,$44,$AA,$AA,$44,$00    ;    '8'
  13540.     .byte    $00,$44,$AA,$AA,$66,$44,$88,$00    ;    '9'
  13541.     .byte    $00,$00,$44,$00,$00,$44,$00,$00    ;    ':'
  13542.     .byte    $00,$00,$44,$00,$44,$44,$88,$00    ;    ';'
  13543.     .byte    $00,$22,$44,$88,$44,$22,$00,$00    ;    '<'
  13544.     .byte    $00,$00,$EE,$00,$EE,$00,$00,$00    ;    '='
  13545.     .byte    $00,$88,$44,$22,$44,$88,$00,$00    ;    '>'
  13546.     .byte    $00,$44,$AA,$22,$44,$00,$44,$00    ;    '?'
  13547.     .byte    $00,$44,$EE,$AA,$88,$66,$00,$00    ;    '@'
  13548.     .byte    $00,$44,$AA,$AA,$EE,$AA,$AA,$00    ;    'A'
  13549.     .byte    $00,$CC,$AA,$CC,$AA,$AA,$CC,$00    ;    'B'
  13550.     .byte    $00,$66,$88,$88,$88,$88,$66,$00    ;    'C'
  13551.     .byte    $00,$CC,$AA,$AA,$AA,$AA,$CC,$00    ;    'D'
  13552.     .byte    $00,$EE,$88,$CC,$88,$88,$EE,$00    ;    'E'
  13553.     .byte    $00,$EE,$88,$CC,$88,$88,$88,$00    ;    'F'
  13554.     .byte    $00,$44,$AA,$88,$AA,$AA,$44,$00    ;    'G'
  13555.     .byte    $00,$AA,$AA,$EE,$AA,$AA,$AA,$00    ;    'H'
  13556.     .byte    $00,$EE,$44,$44,$44,$44,$EE,$00    ;    'I'
  13557.     .byte    $00,$66,$22,$22,$22,$AA,$44,$00    ;    'J'
  13558.     .byte    $00,$AA,$AA,$CC,$AA,$AA,$AA,$00    ;    'K'
  13559.     .byte    $00,$88,$88,$88,$88,$88,$EE,$00    ;    'L'
  13560.     .byte    $00,$AA,$EE,$AA,$AA,$AA,$AA,$00    ;    'M'
  13561.     .byte    $00,$CC,$AA,$AA,$AA,$AA,$AA,$00    ;    'N'
  13562.     .byte    $00,$44,$AA,$AA,$AA,$AA,$44,$00    ;    'O'
  13563.     .byte    $00,$CC,$AA,$AA,$CC,$88,$88,$00    ;    'P'
  13564.     .byte    $00,$44,$AA,$AA,$AA,$AA,$44,$22    ;    'Q'
  13565.     .byte    $00,$CC,$AA,$AA,$CC,$AA,$AA,$00    ;    'R'
  13566.     .byte    $00,$66,$88,$44,$22,$22,$CC,$00    ;    'S'
  13567.     .byte    $00,$EE,$44,$44,$44,$44,$44,$00    ;    'T'
  13568.     .byte    $00,$AA,$AA,$AA,$AA,$AA,$EE,$00    ;    'U'
  13569.     .byte    $00,$AA,$AA,$AA,$AA,$AA,$44,$00    ;    'V'
  13570.     .byte    $00,$AA,$AA,$AA,$AA,$EE,$AA,$00    ;    'W'
  13571.     .byte    $00,$AA,$AA,$44,$AA,$AA,$AA,$00    ;    'X'
  13572.     .byte    $00,$AA,$AA,$AA,$44,$44,$44,$00    ;    'Y'
  13573.     .byte    $00,$EE,$22,$44,$88,$88,$EE,$00    ;    'Z'
  13574.     .byte    $00,$EE,$88,$88,$88,$88,$EE,$00    ;    '['
  13575.     .byte    $00,$88,$88,$44,$44,$22,$22,$00    ;    '\'
  13576.     .byte    $00,$EE,$22,$22,$22,$22,$EE,$00    ;    ']'
  13577.     .byte    $00,$44,$AA,$00,$00,$00,$00,$00    ;    '^'
  13578.     .byte    $00,$00,$00,$00,$00,$00,$00,$FF    ;    '_'
  13579.     .byte    $00,$44,$22,$00,$00,$00,$00,$00    ;    '`'
  13580.     .byte    $00,$00,$CC,$22,$66,$AA,$EE,$00    ;    'a'
  13581.     .byte    $00,$88,$CC,$AA,$AA,$AA,$CC,$00    ;    'b'
  13582.     .byte    $00,$00,$66,$88,$88,$88,$66,$00    ;    'c'
  13583.     .byte    $00,$22,$66,$AA,$AA,$AA,$66,$00    ;    'd'
  13584.     .byte    $00,$00,$44,$AA,$EE,$88,$66,$00    ;    'e'
  13585.     .byte    $00,$66,$88,$CC,$88,$88,$88,$00    ;    'f'
  13586.     .byte    $00,$00,$44,$AA,$AA,$66,$22,$CC    ;    'g'
  13587.     .byte    $00,$88,$CC,$AA,$AA,$AA,$AA,$00    ;    'h'
  13588.     .byte    $00,$44,$00,$44,$44,$44,$44,$00    ;    'i'
  13589.     .byte    $00,$22,$00,$22,$22,$22,$AA,$44    ;    'j'
  13590.     .byte    $00,$88,$AA,$AA,$CC,$AA,$AA,$00    ;    'k'
  13591.     .byte    $00,$CC,$44,$44,$44,$44,$EE,$00    ;    'l'
  13592.     .byte    $00,$00,$AA,$EE,$AA,$AA,$AA,$00    ;    'm'
  13593.     .byte    $00,$00,$CC,$AA,$AA,$AA,$AA,$00    ;    'n'
  13594.     .byte    $00,$00,$44,$AA,$AA,$AA,$44,$00    ;    'o'
  13595.     .byte    $00,$00,$CC,$AA,$AA,$CC,$88,$88    ;    'p'
  13596.     .byte    $00,$00,$44,$AA,$AA,$66,$22,$33    ;    'q'
  13597. ;    .byte    $00,$00,$66,$88,$88,$88,$88,$00    ;    'r'
  13598.     .byte    $00,$00,$CC,$AA,$88,$88,$88,$00    ;    'r', experimental
  13599.     .byte    $00,$00,$66,$88,$44,$22,$CC,$00    ;    's'
  13600.     .byte    $00,$44,$EE,$44,$44,$44,$66,$00    ;    't'
  13601.     .byte    $00,$00,$AA,$AA,$AA,$AA,$EE,$00    ;    'u'
  13602.     .byte    $00,$00,$AA,$AA,$AA,$AA,$44,$00    ;    'v'
  13603.     .byte    $00,$00,$AA,$AA,$AA,$EE,$AA,$00    ;    'w'
  13604.     .byte    $00,$00,$AA,$AA,$44,$AA,$AA,$00    ;    'x'
  13605.     .byte    $00,$00,$AA,$AA,$AA,$66,$22,$CC    ;    'y'
  13606.     .byte    $00,$00,$EE,$22,$44,$88,$EE,$00    ;    'z'
  13607.     .byte    $66,$44,$44,$CC,$44,$44,$66,$00    ;    '{'
  13608.     .byte    $44,$44,$44,$44,$44,$44,$44,$00    ;    '|'
  13609.     .byte    $66,$22,$22,$33,$22,$22,$66,$00    ;    '}'
  13610.     .byte    $00,$55,$AA,$00,$00,$00,$00,$00    ;    '~'
  13611.     .byte    $00,$00,$00,$00,$00,$00,$00,$00    ; space after tilde?
  13612. ;
  13613. ;    graphics, chars $60 thru $7f
  13614. ;
  13615.     .byte    $00,$44,$44,$EE,$EE,$44,$44,$00    ; blot
  13616.     .byte    $AA,$55,$AA,$55,$AA,$55,$AA,$55    ; square blot
  13617.     .byte    $00,$AA,$EE,$AA,$77,$22,$22,$00    ; h/t
  13618.     .byte    $00,$EE,$CC,$88,$77,$66,$44,$00    ; f/f
  13619.     .byte    $00,$CC,$88,$EE,$55,$66,$55,$00    ; c/r
  13620.     .byte    $00,$88,$88,$EE,$77,$66,$44,$00    ; l/f
  13621.     .byte    $00,$EE,$AA,$EE,$00,$00,$00,$00    ; degrees
  13622.     .byte    $00,$00,$44,$EE,$44,$44,$EE,$00    ; plus/minus
  13623.     .byte    $00,$AA,$EE,$AA,$44,$44,$77,$00    ; n/l
  13624.     .byte    $00,$AA,$AA,$44,$77,$22,$22,$00    ; v/t
  13625.     .byte    $44,$44,$44,$CC,$00,$00,$00,$00    ; down right corner
  13626.     .byte    $00,$00,$00,$CC,$44,$44,$44,$44    ; up right corner
  13627.     .byte    $00,$00,$00,$77,$44,$44,$44,$44    ; up left corner
  13628.     .byte    $44,$44,$44,$77,$00,$00,$00,$00    ; down left corner
  13629.     .byte    $44,$44,$44,$FF,$44,$44,$44,$44    ; center cross
  13630.     .byte    $FF,$00,$00,$00,$00,$00,$00,$00    ; scan 1
  13631.     .byte    $00,$FF,$00,$00,$00,$00,$00,$00 ; scan 3 (really 2)
  13632.     .byte    $00,$00,$00,$FF,$00,$00,$00,$00 ; scan 5 (really 4)
  13633.     .byte    $00,$00,$00,$00,$00,$FF,$00,$00    ; scan 7 (really 6)
  13634.     .byte    $00,$00,$00,$00,$00,$00,$00,$FF    ; scan 9 (really 8)
  13635.     .byte    $44,$44,$44,$77,$44,$44,$44,$44    ; left t
  13636.     .byte    $44,$44,$44,$CC,$44,$44,$44,$44    ; right t
  13637.     .byte    $44,$44,$44,$FF,$00,$00,$00,$00    ; bottom t
  13638.     .byte    $00,$00,$00,$FF,$44,$44,$44,$44    ; top t
  13639.     .byte    $44,$44,$44,$44,$44,$44,$44,$44    ; vert bar
  13640.     .byte    $00,$22,$44,$88,$44,$22,$EE,$00    ; <=
  13641.     .byte    $00,$88,$44,$22,$44,$88,$EE,$00    ; >=
  13642.     .byte    $00,$00,$00,$EE,$AA,$AA,$AA,$00    ; pi
  13643.     .byte    $00,$22,$EE,$44,$EE,$88,$00,$00    ; not equal
  13644.     .byte    $00,$CC,$88,$CC,$88,$88,$EE,$00    ; lbs Sterling
  13645.     .byte    $00,$00,$00,$66,$66,$00,$00,$00    ; center dot
  13646. ; $7f ever used?  if so, it goes here
  13647.  
  13648. ;
  13649. ;    scr40el0 - Perform the vt100 erase line function #0 on 80 column screen
  13650. ;
  13651. ;    Input:    number of line to erase in rowcrs
  13652. ;    Output: None
  13653. ;
  13654. ;    Registers destroyed - A,X,Y
  13655. ;
  13656. ;    This routine erases from the cursor to the end of the line
  13657. ;
  13658.  
  13659. scr40el0:
  13660.     ldy    ROWCRS
  13661.     ldx    COLCRS
  13662.     jsr    scr40adrt    ; figure out where to start
  13663.     ldy    #0
  13664.     lda    #80        ; subtract current col to get count
  13665.     sec
  13666.     sbc    COLCRS
  13667.     beq    scr40el0z    ; done!
  13668.     tax
  13669.     lda    #0        ; space minus offset
  13670.     jsr    fillx        ; fill x many with (a)
  13671. scr40el0z:
  13672.     rts            ; all done
  13673.  
  13674. ;
  13675. ;    scr40el1 - Perform the VT100 Erase Line function #1 on 80 column screen
  13676. ;
  13677. ;    Input:    Number of line to erase in ROWCRS
  13678. ;    Output: None
  13679. ;
  13680. ;    Registers destroyed - A,X,Y
  13681. ;
  13682. ;    This routine erases from the beginning of line to cursor
  13683. ;
  13684.  
  13685. scr40el1:
  13686.     ldy    ROWCRS
  13687.     ldx    #0
  13688.     jsr    scr40adrt    ; compute the cursors address
  13689.     ldy    #0        ; index from start in screen mem
  13690.     ldx    COLCRS        ; this many
  13691.     beq    scr40el1z
  13692.     lda    #0        ; space minue offset
  13693.     jsr    fillx        ; fill x many
  13694. scr40el1z:
  13695.     rts            ; all done
  13696.  
  13697. ;
  13698. ;    scr40el2 - Perform the VT100 Erase Line function #2 on 40/80 column screen
  13699. ;
  13700. ;    Input:    Number of line to erase in ROWCRS
  13701. ;    Output: None
  13702. ;
  13703. ;    Registers destroyed - A,X,Y
  13704. ;
  13705. ;    This routine erases one line compleatly from the 40/80 column display.
  13706. ;
  13707.  
  13708. scr40el2:
  13709.     lda    COLCRS
  13710.     pha            ; save cursor temporarily
  13711.     lda    #0
  13712.     sta    COLCRS
  13713.     jsr    scr40el0    ; whack from temp cursor to eol
  13714.     pla
  13715.     sta    COLCRS        ; put it back
  13716.     rts
  13717.  
  13718. ;
  13719. ;    scr40ind - perform the VT100 index function (scroll the screen)
  13720. ;
  13721. ;    Input:    None
  13722. ;    Output: None
  13723. ;
  13724. ;    Registers destroyed - A,X,Y
  13725. ;
  13726. ;    This routine scrolls the screen in 40/80 column mode.  Only the area
  13727. ;    in the scrolling region is changed.
  13728. ;
  13729.  
  13730. scr40ind:
  13731.     lda    top        ; get top row to scroll
  13732.     sta    strptr        ; we'll use that as row counter
  13733. scr40ind1:
  13734.     tay            ; get row into y
  13735.     iny            ; top + 1
  13736.     ldx    #0        ; col 1 again
  13737.     jsr    scr40adrt
  13738.     lda    dest        ; this wants
  13739.     sta    source        ;  to be the
  13740.     lda    dest+1        ;   source addr
  13741.     sta    source+1
  13742.     ldy    strptr        ; get row again
  13743.     ldx    #0        ; col 1
  13744.     jsr    scr40adrt    ; find address
  13745.     ldx    #80        ; byte count
  13746.     jsr    movex        ; move x many
  13747.     inc    strptr        ; bump row counter
  13748.     lda    strptr        ; get it
  13749.     cmp    bot        ; we there yet?
  13750.     bcc    scr40ind1    ; less than, go back for more
  13751.  
  13752.     ldx    #0
  13753.     ldy    bot        ; clear bottom line
  13754.     jsr    scr40adrt
  13755.     ldx    #80        ; byte count
  13756.     lda    #0        ; space minus offset
  13757.     jsr    fillx        ; fill x many
  13758.     rts            ; go home
  13759.  
  13760. ;
  13761. ;    scr40ri - perform the VT100 reverse index function (scroll backwards)
  13762. ;
  13763. ;    Input:    None
  13764. ;    Output: None
  13765. ;
  13766. ;    Registers destroyed - A,X,Y
  13767. ;
  13768. ;    This routine scrolls the screen in 80 column mode.  Only the area
  13769. ;    in the scrolling region is changed.
  13770. ;
  13771. scr40ri:
  13772.     lda    bot        ; bottom row
  13773.     sta    strptr        ; handy temp row counter
  13774. scr40ri1:
  13775.     tay            ; get it into Y
  13776.     dey            ; bot - 1
  13777.     ldx    #0        ; col 1 again
  13778.     jsr    scr40adrt
  13779.     lda    dest        ; this wants
  13780.     sta    source        ;  to be the
  13781.     lda    dest+1        ;   source addr
  13782.     sta    source+1
  13783.     ldy    strptr        ; row again
  13784.     ldx    #0        ; col 1
  13785.     jsr    scr40adrt    ; find address
  13786.     ldx    #80        ; byte count
  13787.     jsr    movex
  13788.     dec    strptr        ; dec row index
  13789.     lda    strptr        ; get it
  13790.     cmp    top        ; we there yet?
  13791.     bne    scr40ri1    ; nope, do anoter one
  13792.  
  13793.     ldx    #0
  13794.     ldy    top        ; clear bottom line
  13795.     jsr    scr40adrt
  13796.     ldx    #80
  13797.     lda    #0        ; space minus offset
  13798.     jsr    fillx
  13799.     rts            ; go home
  13800.  
  13801. ;
  13802. ;    scr40fls - flash the screen and cursor in 80 column mode
  13803. ;
  13804. ;    Input:    None
  13805. ;    Output: None
  13806. ;
  13807. ;    Registers destroyed - A,X,Y
  13808. ;
  13809. ;    This routine flashes the screen in 40/80 column mode
  13810. ;    No op on Atari...
  13811. ;
  13812.  
  13813. scr40fls: rts
  13814.  
  13815. ;
  13816. ;    scr40tgl - toggle the cursor in 40/80 column mode
  13817. ;
  13818. ;    Input:    None
  13819. ;    Output: None
  13820. ;
  13821. ;    Registers destroyed - A,X,Y
  13822. ;
  13823. ;    This routine toggles the cursor in 80 column mode.
  13824. ;
  13825.  
  13826. scr40tgl:
  13827. ;    ldy    ROWCRS        ; compute cursor address
  13828. ;    ldx    COLCRS
  13829.     sec
  13830.     jsr    ploth        ; filter for rightmost col
  13831.     jsr    scr40adrt
  13832.     ldy    #0
  13833.     lda    (dest),y    ; get old character value
  13834.     eor    #$80        ; toggle hi bit
  13835.     sta    (dest),y    ; stick it back
  13836. scr40tgl1: rts
  13837.  
  13838.  
  13839. ;
  13840. ;    scr40adr - calculate 80*y+x
  13841. ;
  13842. ;    Input:    numbers in x-reg and y-reg
  13843. ;    Output: dest
  13844. ;
  13845. ;    Registers destroyed - A,Y
  13846. ;
  13847. ;    This routine calculates 80*y+x and puts the result in dest.  If x > 80,
  13848. ;    one is subtracted first.  This will happen after a character is printed
  13849. ;    on the last character on a line.  This routine is for calculating
  13850. ;    screen addresses.
  13851. ;
  13852.  
  13853. scr40adr:
  13854.     sty    dest        ; put y-reg in dest
  13855.     lda    #0        ; zero extend
  13856.     sta    dest+1
  13857.     asl    dest        ; multiplied by 2
  13858.     rol    dest+1
  13859.     asl    dest        ; multiplied by 4
  13860.     rol    dest+1
  13861.     tya            ; add in y to get 5*y
  13862.     adc    dest        ; carry is clear
  13863.     sta    dest
  13864.     bcc    scr40adr1
  13865.     inc    dest+1
  13866. scr40adr1: asl    dest        ; multiplied by 10
  13867.     rol    dest+1
  13868.     asl    dest        ; multiplied by 20
  13869.     rol    dest+1
  13870.     asl    dest        ; multiplied by 40
  13871.     rol    dest+1
  13872.     asl    dest        ; multiplied by 80
  13873.     rol    dest+1
  13874.     cpx    #80        ; are we in the funny col?
  13875.     bcc    scr40adr2    ; no
  13876.     ldx    #79
  13877. scr40adr2: txa            ; add in x-reg
  13878.     clc
  13879.     adc    dest
  13880.     sta    dest
  13881.     bcc    scr40adr3
  13882.     inc    dest+1
  13883. scr40adr3: rts            ; all done
  13884.  
  13885. ;
  13886. ;    scr40adrt - calculate address of a text character for 40/80 column mode
  13887. ;
  13888. ;    Input:    x coordinate in x-reg
  13889. ;        y coordinate in y-reg
  13890. ;    Output: dest
  13891. ;
  13892. ;    Registers destroyed - A,X,Y
  13893. ;
  13894. ;    This routine calculates the address of a character at x,y in 40/80
  13895. ;    column mode.  It uses scr40adr to set things up and adds scrmem base
  13896. ;
  13897.  
  13898. scr40adrt:
  13899.     jsr    scr40adr        ; freak out scraeadr
  13900.     lda    #scrmemlo\        ; add base addr
  13901.     clc
  13902.     adc    dest
  13903.     sta    dest
  13904.     lda    #scrmemlo^
  13905.     adc    dest+1
  13906.     sta    dest+1
  13907.     rts
  13908. ;
  13909. ; Stuff for panning the screen in 40/80 mode
  13910. ;
  13911.  
  13912. ;
  13913. ;    Pan40    frobnicate the display list pointers to point
  13914. ;    wherever they normally would plus panval.
  13915. ;
  13916. pan40:
  13917.     lda    ROWCRS        ; save cursor
  13918.     pha            ;  coords thru this
  13919.     lda    COLCRS
  13920.     pha
  13921.     lda    #0        ; now zap them to zero
  13922.     sta    ROWCRS
  13923.     sta    COLCRS
  13924.     lda    #dlist+3\    ; addr of line 0 display list inst
  13925.     sta    source
  13926.     lda    #dlist+3^
  13927.     sta    source+1
  13928. pan40a:
  13929.     ldx    COLCRS
  13930.     ldy    ROWCRS
  13931.     jsr    scr40adrt    ; figure out base address
  13932.     lda    ROWCRS        ; get offset into display list
  13933.     clc
  13934.     adc    ROWCRS        ; they're 3 bytes long
  13935.     adc    ROWCRS
  13936.     tay            ; into y
  13937.     iny            ; point at addr lo byte in DL
  13938.     lda    dest        ; stuff in screen mem ptr lo
  13939.     clc
  13940.     adc    panval        ; plus pan value
  13941.     sta    (source),y
  13942.     lda    dest+1        ; get hi byte
  13943.     adc    #0        ; plus carry
  13944.     iny
  13945.     sta    (source),y
  13946.     inc    ROWCRS        ; next line please
  13947.     lda    ROWCRS
  13948.     cmp    #24        ; off the end?
  13949.     bne    pan40a
  13950.     pla            ; get cursor back
  13951.     sta    COLCRS
  13952.     pla
  13953.     sta    ROWCRS
  13954.     rts            ; done!
  13955.  
  13956. ;
  13957. ; frob for updating status line flds that change on the fly.
  13958. ;
  13959. updstat:
  13960.     lda    #$1D+$40    ; internal code for down arrow
  13961.     sec
  13962.     sbc    capslck        ; buys up-arrow if set
  13963.     sta    statline+26
  13964. ;
  13965.     lda    fxoff        ; him x'ed off?
  13966.     beq    updsxon        ; no, he's on
  13967.     lda    #'--$20
  13968.     bne    updsx
  13969. updsxon:
  13970.     lda    #'+-$20
  13971. updsx:    sta    statline+22
  13972. ;
  13973.     lda    suspend        ; suspended?
  13974.     beq    updss        ; nope, display the 0, shows up as space
  13975.     lda    #$14+$40    ; display a blot
  13976.     ldx    scrtype        ; what kind of screen are we using?
  13977.     cpx    #scr40        ; a 40-col one?
  13978.     bne    updss        ; nope, it's ok
  13979.     lda    #$00+$40    ; blot in 40-col font
  13980. updss:    sta    statline+24
  13981. ; zzz more later
  13982.     rts 
  13983.  
  13984. ;
  13985. ; Make a display list preamble, for both 40/80 and graphics screens
  13986. ;
  13987. makedlp:
  13988.     lda    #dlist\        ; start of display list mem
  13989.     sta    dest
  13990.     lda    #dlist^
  13991.     sta    dest+1
  13992.     ldy    #0
  13993.     lda    #$70        ; 8 blank lines
  13994.     sta    (dest),y
  13995.     iny
  13996.     sta    (dest),y    ; 8 more
  13997.     iny
  13998.     lda    #$20        ; 3 blank lines
  13999.     sta    (dest),y
  14000.     iny
  14001.     lda    #scrmemlo\    ; set source up to point at screen mem
  14002.     sta    source
  14003.     lda    #scrmemlo^
  14004.     sta    source+1
  14005.     rts
  14006.  
  14007. ;
  14008. ; Make the common postamble
  14009. ;
  14010. makedlx:
  14011.     lda    #$42        ; character mode please
  14012.     sta    (dest),y
  14013.     iny
  14014.     lda    #statline\    ; point at status line
  14015.     sta    (dest),y
  14016.     iny
  14017.     lda    #statline^
  14018.     sta    (dest),y
  14019.     iny
  14020.     lda    #$41        ; jump and wait for Vsync
  14021.     sta    (dest),y
  14022.     iny
  14023.     lda    #dlist\        ; back to beginning of list
  14024.     sta    (dest),y
  14025.     iny
  14026.     lda    #dlist^
  14027.     sta    (dest),y    ; done!
  14028.     rts    
  14029. ;
  14030. ; Make a display list for the 40/80 pannable screen
  14031. ;
  14032. makedl40:
  14033.     jsr    makedlp        ; do the preamble
  14034.     ldx    #24        ; 24 lines like this
  14035. mkdl40a:
  14036.     lda    #$42        ; load scan pointer, char mode instruction
  14037.     sta    (dest),y
  14038.     iny
  14039.     lda    source        ; get pointer to block of mem
  14040.     sta    (dest),y
  14041.     iny
  14042.     clc            ; bump it by 80 while we're at it, for next pass
  14043.     adc    #80
  14044.     sta    source
  14045.     lda    source+1    ; get hi byte
  14046.     sta    (dest),y    ; into display list
  14047.     iny
  14048.     adc    #0        ; add carry from lo byte
  14049.     sta    source+1
  14050.     dex            ; dec counter
  14051.     bne    mkdl40a        ; more lines, go do them
  14052.     jsr    makedlx        ; make the postamble
  14053.     rts
  14054.  
  14055. ;
  14056. ; Make a display list for the 80 column graphics screen
  14057. ;
  14058. makedl80:
  14059.     jsr    makedlp        ; do the preamble
  14060.     lda    #$4F        ; hi-res graphics please, 
  14061.     sta    (dest),y
  14062.     iny
  14063.     lda    #scrmemlo\    ; starting at screen mem
  14064.     sta    (dest),y
  14065.     iny
  14066.     lda    #scrmemlo^
  14067.     sta    (dest),y
  14068.     iny
  14069.     jsr    mkdl80z        ; make 95 rasters worth
  14070.     lda    #$4F        ; hi-res graphics please, 
  14071.     sta    (dest),y
  14072.     iny
  14073.     lda    #scrmemhi\    ; starting at screen mem
  14074.     sta    (dest),y
  14075.     iny
  14076.     lda    #scrmemhi^
  14077.     sta    (dest),y
  14078.     iny
  14079.     jsr    mkdl80z        ; make another 95 rasters worth
  14080.     jsr    makedlx        ; make the postamble
  14081.     rts            ; done!
  14082.  
  14083. mkdl80z:
  14084.     ldx    #95        ; 95 more rasters of hi-res graphics
  14085.     lda    #$0F
  14086. mkdl80a:
  14087.     sta    (dest),y
  14088.     iny
  14089.     dex
  14090.     bne    mkdl80a
  14091.     rts
  14092.  
  14093. .SBTTL    40 Column screen driver
  14094.  
  14095. ;
  14096. ;    These routines manipulate the screen in 40 column mode.
  14097. ;
  14098.  
  14099. ;
  14100. ;    scraeini - initilize the 40 column screen
  14101. ;
  14102. ;    Input:    None
  14103. ;
  14104. scraeini:
  14105.     rts            ; all done
  14106.  
  14107. ;
  14108. ;    scraeent - enter the 40 column screen driver
  14109. ;
  14110. ;    Input:    None
  14111. ;    Output: None
  14112. ;
  14113. ;    Registers destroyed - A,X,Y
  14114. ;
  14115. ;    This routine starts the 40 column screen driver.
  14116. ;    these days, that's just resetting the real display list to the one we
  14117. ;    got when we opened the screen, turning off wrap, 
  14118. ;    and resetting the colors
  14119. ;
  14120.  
  14121. scraeent:
  14122.     lda    scraedl
  14123.     ldy    scraedl+1
  14124.     jsr    setdlist    ; go set it safely (?)
  14125.     lda    scraec1        ; get color1 value
  14126.     sta    COLOR1
  14127.     lda    scraec2
  14128.     sta    COLOR2
  14129.     lda    scraec4
  14130.     sta    COLOR4
  14131.     lda    scraer        ; get orig row value
  14132.     sta    ROWCRS
  14133.     lda    #$FF        ; wrap off, please
  14134.     sta    wrap
  14135.     lda    #scrae        ; go back to atari E: screen
  14136.     sta    scrtype
  14137.     rts            ; all done
  14138.  
  14139. ;
  14140. ;    scraeext - exit the E: screen driver
  14141. ;    Not really.  Just here for compatibility
  14142.  
  14143. ;    Input:    None
  14144. ;    Output: None
  14145. ;
  14146. ;    Registers destroyed - A,X,Y
  14147. ;
  14148. ;    This routine exits from the 40 column screen driver.
  14149. ;
  14150.  
  14151. scraeext:
  14152.     lda    SDLSTL        ; remember display list addr for when we change
  14153.     sta    scraedl
  14154.     lda    SDLSTH
  14155.     sta    scraedl+1
  14156.     lda    COLOR1        ; remember color settings
  14157.     sta    scraec1
  14158.     lda    COLOR2
  14159.     sta    scraec2
  14160.     lda    COLOR4
  14161.     sta    scraec4
  14162.     lda    ROWCRS
  14163.     sta    scraer        ; remember row value
  14164.     rts            ; all done
  14165.  
  14166. ;    scraeput - put a character at COLCRS, ROWCRS
  14167. ;
  14168. ;    Input:    character to put in a-reg (use funny ascii)
  14169. ;    Output: None
  14170. ;
  14171. ;    Registers destroyed - A,X,Y
  14172. ;
  14173. ;    This routine puts a character at screen position COLCRS,ROWCRS.  
  14174. ;    This routine does advance the cursor position.
  14175. ;
  14176.  
  14177. scraeput:
  14178.     jsr    sputch        ; put it using the builting E: driver
  14179. ;    dec    COLCRS        ; put column counter back
  14180. ;    bpl    scraeput4    ; should be pos
  14181. ;    lda    #0        ; no? ok zap it
  14182. ;    sta    COLCRS
  14183. scraeput4: rts            ; all done.
  14184.  
  14185. ;
  14186. ;    scraeel0 - Perform the VT100 Erase Line function #0 on 40 column screen
  14187. ;
  14188. ;    Input:    Number of line to erase in ROWCRS
  14189. ;    Output: None
  14190. ;
  14191. ;    Registers destroyed - A,X,Y
  14192. ;
  14193. ;    This routine erases from the cursor to the end of the line
  14194. ;
  14195.  
  14196. scraeel0:
  14197.     lda    COLCRS        ; get column
  14198.     pha            ; save it
  14199. scrael01:
  14200.     lda    #39        ; at eol yet?
  14201.     cmp    COLCRS
  14202.     beq    scrael02    ; yup, go home
  14203.     lda    #space        ; get a space
  14204.     jsr    sputch        ; shove it out
  14205.     jmp    scrael01    ; go around again
  14206. scrael02:
  14207.     pla            ; get column back
  14208.     sta    COLCRS
  14209.     rts
  14210.  
  14211. ;
  14212. ;    scraeel1 - Perform the VT100 Erase Line function #1 on 40 column screen
  14213. ;
  14214. ;    Input:    Number of line to erase in ROWCRS
  14215. ;    Output: None
  14216. ;
  14217. ;    Registers destroyed - A,X,Y
  14218. ;
  14219. ;    This routine erases from the beginning of line to cursor
  14220. ;
  14221.  
  14222. scraeel1:
  14223.     lda    COLCRS        ; get col
  14224.     pha            ; save it
  14225.     lda    #0        ; and zap it
  14226.     sta    COLCRS
  14227. scrael11:
  14228.     pla            ; get original col back
  14229.     cmp    COLCRS        ; are we home yet?
  14230.     beq    scrael12    ; yup, go home
  14231.     pha            ; nope, save it again
  14232.     lda    #space        ; get a space
  14233.     jsr    sputch        ; shove it out
  14234.     jmp    scrael11    ; go around again
  14235. scrael12:
  14236.     rts
  14237.  
  14238. ;
  14239. ;    scraeel2 - Perform the VT100 Erase Line function #2 on 40 column screen
  14240. ;
  14241. ;    Input:    Number of line to erase in ROWCRS
  14242. ;    Output: None
  14243. ;
  14244. ;    Registers destroyed - A,X,Y
  14245. ;
  14246. ;    This routine erases one line compleatly from the 40 column display.
  14247. ;
  14248.  
  14249. scraeel2:
  14250.     lda    COLCRS        ; save column
  14251.     pha
  14252.     lda    #0        ; zap it to 0
  14253.     sta    COLCRS
  14254.     jsr    scraeel0    ; zap to eol
  14255.     pla            ; get it back
  14256.     sta    COLCRS
  14257.     rts            ; all done
  14258.  
  14259. ;
  14260. ;    scraeind - perform the VT100 index function (scroll the screen)
  14261. ;
  14262. ;    Input:    None
  14263. ;    Output: None
  14264. ;
  14265. ;    Registers destroyed - A,X,Y
  14266. ;
  14267. ;    Can't do this in E: device, so it's a no-op
  14268. ;
  14269. ;
  14270.  
  14271. scraeind: 
  14272.     rts
  14273.     
  14274. ;
  14275. ;    scraeri - perform the VT100 reverse index function (scroll backwards)
  14276. ;
  14277. ;    Input:    None
  14278. ;    Output: None
  14279. ;
  14280. ;    Registers destroyed - A,X,Y
  14281. ;
  14282. ;    This one too.
  14283. ;
  14284.  
  14285. scraeri: rts            ; zzz can we do this?
  14286.     
  14287. ;
  14288. ;    scraefls - flash the screen in 40 column mode
  14289. ;    No-op
  14290. ;
  14291.  
  14292. scraefls:
  14293.     rts            ; all done
  14294.  
  14295. ;
  14296. ;    scraetgl - toggle the cursor in ae column mode
  14297. ;    This is really only useful for making the cursor show up
  14298. ;    in the right place.
  14299. ;
  14300.  
  14301. scraetgl:
  14302.     lda    #$1F        ; go right a char
  14303.     jsr    sputch
  14304.     lda    #$1E        ; go left a char.  Sigh
  14305.     jsr    sputch
  14306.     rts
  14307.  
  14308. ;
  14309. ; 80-col stuff
  14310. ;
  14311.  
  14312. ;
  14313. ;    Scr80ent.    Enter the 80-column graphics screen
  14314. ;
  14315. scr80ent:
  14316.     jsr    makedl80
  14317.     lda    scr80dl
  14318.     ldy    scr80dl+1
  14319.     jsr    setdlist
  14320.     lda    backclr        ; grey, hi luminance
  14321.     sta    COLOR2        ;  shows up on 0 bits
  14322.     lda    foreclr        ; grey, lo luminance (only lum counts)
  14323.     sta    COLOR1        ;  shows up on 1 bits
  14324.     lda    bordclr        ; make background like 0 bits, a little
  14325.     sta    COLOR4        ;  dimmer
  14326.     lda    #scr80        ; we're now in graphics mode
  14327.     sta    scrtype
  14328.     rts
  14329.  
  14330. ;
  14331. ;    Scr80ext.    Exit the 80-col graphics screen
  14332. ;
  14333. scr80ext:
  14334.     jmp    scraeent    ; back to atari mode
  14335.     
  14336. ;
  14337. ;    scr80adr - calculate int(x/2) and x%2
  14338. ;
  14339. ;    Input:    number in x-reg
  14340. ;    Output: evenodd = $0f if x is odd, $f0 if x is even
  14341. ;        x-reg = x-reg/2
  14342. ;
  14343. ;    Registers destroyed - A,X
  14344. ;
  14345. ;    This routine calculated int(x/2) and x % 2.  It is used to freak
  14346. ;    scraeadr into calculating addresses for 80 column mode.  Real
  14347. ;    funny things happen if the x-reg is the funny column (81).
  14348. ;
  14349.  
  14350. scr80adr:
  14351.     cpx    #80        ; is the cursor in the funny column?
  14352.     bcc    scr80adr2        ; no
  14353.     ldx    #81        ; 81 % 2 = 1
  14354. scr80adr2:
  14355.     txa            ; divide x by two
  14356.     lsr    a
  14357.     tax            ; put result back in x-reg
  14358.     lda    #$0F        ; put $0f in evenodd if odd
  14359.     bcs    scr80adr1        ; is odd
  14360.     lda    #$F0        ; put $f0 in evenodd if even
  14361. scr80adr1:
  14362.     sta    evenodd
  14363.     rts
  14364.  
  14365. ;
  14366. ;     scr80adrt.  compute (y * 320) + (x / 2) + scrmem, leave it in dest
  14367. ;     actually, mem is split, but we hide all that in here
  14368. ;
  14369. scr80adrt:
  14370.     tya            ; save this value
  14371.     pha
  14372.     cmp    #12        ; which half?
  14373.     bcc    s80a1        ; lo half, leave it
  14374.     sbc    #12        ; sub 12, carry's set
  14375. s80a1:
  14376.     sta    dest
  14377.     lda    #0
  14378.     sta    dest+1        ; zap top half
  14379.     jsr    scr80adr    ; do the even/odd stuff
  14380.     asl    dest        ; * 2
  14381.     lda    dest        ; we'll need this in a sec
  14382.     asl    dest        ; * 4
  14383.     asl    dest        ; * 8
  14384.     adc    dest        ; carry's clear, from shifts
  14385.     sta    dest        ; * 10
  14386.     asl    dest
  14387.     rol    dest+1        ; * 20
  14388.     asl    dest
  14389.     rol    dest+1        ; * 40
  14390.     asl    dest
  14391.     rol    dest+1        ; * 80
  14392.     asl    dest
  14393.     rol    dest+1        ; * 160
  14394.     asl    dest
  14395.     rol    dest+1        ; * 320
  14396.     txa            ; x has col / 2 in it
  14397.     adc    dest        ; carry's clear from shifts
  14398.     sta    dest
  14399.     lda    dest+1
  14400.     adc    #0        ; add carry to hi byte
  14401.     sta    dest+1
  14402.     pla            ; now add lo or hi mem base
  14403.     cmp    #12
  14404.     bcs    s80a2        ; hi half
  14405.     lda    dest        ; now add screen mem lo
  14406.     adc    #scrmemlo\
  14407.     sta    dest
  14408.     lda    dest+1
  14409.     adc    #scrmemlo^
  14410.     sta    dest+1
  14411.     rts
  14412. s80a2:
  14413.     clc
  14414.     lda    dest        ; now add screen mem lo
  14415.     adc    #scrmemhi\
  14416.     sta    dest
  14417.     lda    dest+1
  14418.     adc    #scrmemhi^
  14419.     sta    dest+1
  14420.     rts
  14421. ;
  14422. ; Put a byte in 80-col graphics mode
  14423. ;
  14424. scr80put:
  14425.     and    #$7F        ; seven bits only, here
  14426. ;
  14427. ; first figure out if we're doing graphics
  14428. ;
  14429.     cmp    #$60        ; lower case?
  14430.     bcc    scr80p1        ; nope, do the subtract
  14431.     ldx    csg0        ; default, G0
  14432.     ldy    altcs        ; using alternate instead?
  14433.     beq    scr80p0        ; nope, use this one
  14434.     ldx    csg1        ; ok, use G1
  14435. scr80p0:
  14436.     cpx    #csascii    ; using ascii?
  14437.     bne    scr80p2        ; no, skip the subtract, for graphics
  14438. scr80p1:
  14439.     sec
  14440.     sbc    #$20        ; offset for font80
  14441. scr80p2:
  14442.     pha            ; save character put
  14443.     sta    source        ; compute character*8+font80
  14444.     lda    #0
  14445.     sta    source+1
  14446.     asl    source        ; multiplied by 2
  14447.     rol    source+1
  14448.     asl    source        ; multiplied by 4
  14449.     rol    source+1
  14450.     asl    source        ; multiplied by 8
  14451.     rol    source+1
  14452.     lda    source        ; now add in font80
  14453.     adc    #font80\    ; carry is clear
  14454.     sta    source
  14455.     lda    source+1
  14456.     adc    #font80^
  14457.     sta    source+1
  14458.     ldy    ROWCRS        ; compute the address to store at
  14459.     ldx    COLCRS
  14460.     jsr    scr80adrt        
  14461.     ldy    #0        ; index into font
  14462. scr80put1:
  14463.     ldx    #0        ; to index thru dest
  14464.     lda    (dest,x)    ; select hi or low half      abcdefgh
  14465.     eor    (source),y    ;                 ABCDEFGH
  14466.     and    evenodd        ;                 xxxx0000
  14467.     eor    (dest,x)    ;                 ABCDefgh
  14468.     cpy    #7        ; on row 7?
  14469.     bne    scr80put8    ; nope, don't check for underlining
  14470.     ldx    underln        ; underlining?
  14471.     beq    scr80put8    ; nope
  14472.     ora    evenodd        ; yes, set all bits this row
  14473. scr80put8:
  14474.     ldx    reverse        ; $01 is reverse on, $00 is reverse off
  14475.     beq    scr80put7
  14476.     eor    evenodd        ; reverse the character
  14477. scr80put7:
  14478.     ldx    #0        ; for indexing again
  14479.     sta    (dest,x)    ; finally put it back
  14480.     lda    dest        ; bump dest by 40
  14481.     clc
  14482.     adc    #40
  14483.     sta    dest
  14484.     lda    dest+1
  14485.     adc    #0
  14486.     sta    dest+1
  14487.     iny
  14488.     cpy    #8        ; off end of font yet?
  14489.     bcc    scr80put1    ; put in the entire character (8bytes)
  14490.     jmp    scr80put2
  14491. scr80put6:
  14492. ;    ldy    #$07
  14493. ;    lda    evenodd
  14494. ;    eor    #$ff
  14495. ;    and    (dest),y
  14496. ;    sta    (dest),y
  14497. scr80put2:
  14498. ; not round here...
  14499.     pla            ; check to see if color must be updated
  14500. ;    bne    scr80put3        ; if character is not a space, update
  14501. ;    lda    reverse        ; if reverse on, update
  14502. ;    bne    scr80put3
  14503. ;    lda    underln        ; if underline on, update
  14504. ;    beq    scr80put4
  14505. scr80put3:
  14506. ;    ldy    ROWCRS        ; calculate primary color address
  14507. ;    ldx    COLCRS
  14508. ;    jsr    scr80adrp
  14509. ;    ldx    alternt        ; 1=alternate color, 0=normal color
  14510. ;    lda    foreclr,x    ; get proper foreground color
  14511. ;    asl    a        ; put in high nybble
  14512. ;    asl    a
  14513. ;    asl    a
  14514. ;    asl    a
  14515. ;    ora    backclr        ; or in background color
  14516. ;    ldy    #0
  14517. ;    sta    (dest),y    ; adjust primary color ram
  14518. ;    pha            ; save for future use
  14519. ;    ldy    ROWCRS        ; compute alternate color address
  14520. ;    ldx    COLCRS
  14521. ;    jsr    scr80adra
  14522. ;    pla            ; restore colors used for primary color
  14523. ;    ldx    flash        ; can we use it?
  14524. ;    beq    scr80put5        ; yes.
  14525. ;    lda    backclr        ; no. screen is flashing.
  14526. ;    asl    a        ; use background color for forground
  14527. ;    asl    a
  14528. ;    asl    a
  14529. ;    asl    a
  14530. ;    ora    backclr
  14531. scr80put5:
  14532. ;    ldy    #0
  14533. ;    sta    (dest),y    ; adjust alternate color ram
  14534. scr80put4:
  14535.     inc    COLCRS        ; bump column
  14536.     rts            ; all done.
  14537.  
  14538. ; stubs
  14539. scr80fls: rts
  14540.  
  14541. scr80tgl:
  14542. ;    ldx    COLCRS        ; figure out where we are
  14543. ;    ldy    ROWCRS
  14544.     sec
  14545.     jsr    ploth        ; filter for rightmost col
  14546.     jsr    scr80adrt
  14547.     ldx    #8        ; do 8 slots
  14548.     ldy    #0
  14549. scr80t1:
  14550.     lda    (dest),y    ; get screen data
  14551.     eor    evenodd        ; toggle the proper half
  14552.     sta    (dest),y    ; put it back
  14553.     lda    dest        ; bump pointer by 40
  14554.     clc
  14555.     adc    #40
  14556.     sta    dest
  14557.     bcc    scr80t2        ; no carry, don't bother with top
  14558.     inc    dest+1
  14559. scr80t2:
  14560.     dex            ; dec raster counter
  14561.     bne    scr80t1        ; go back for another raster
  14562.     rts
  14563.  
  14564. ;
  14565. ;    Scr80el0:    Erase from cursor to EOL in 80-col mode
  14566. ;
  14567. scr80el0: 
  14568.     ldx    COLCRS        ; get col,
  14569.     ldy    ROWCRS        ; and row,
  14570.     jsr    scr80adrt    ; and figure out where we are
  14571.     stx    strptr+1    ; x still has col / 2 in it
  14572.     lda    #8        ; init raster counter
  14573.     sta    strptr        ; handy temp
  14574. scr80e0a:
  14575.     ldy    #0        ; start index
  14576.     lda    #40        ; line length, bytes
  14577.     ldx    evenodd        ; $0F if on odd col
  14578.     bmi    scr80e0b    ; $F0, even col, so go ahead
  14579.     lda    #$F0        ; make a mask for the col we want
  14580.     and    (dest),y    ; mask it
  14581.     sta    (dest),y    ; and put it back
  14582.     iny            ; skip this byte
  14583.     lda    #39        ; and count will be one less
  14584. scr80e0b:
  14585.     sec
  14586.     sbc    strptr+1    ; remaining byte count
  14587.     beq    scr80e0d    ; zero? ok, already at eol
  14588.     tax            ; back to x
  14589.     lda    #0
  14590. scr80e0c:
  14591.     sta    (dest),y    ; clear rest of raster
  14592.     iny
  14593.     dex
  14594.     bne    scr80e0c
  14595. scr80e0d:
  14596.     lda    dest        ; get byte pointer
  14597.     clc
  14598.     adc    #40        ; next row please
  14599.     sta    dest
  14600.     lda    dest+1
  14601.     adc    #0
  14602.     sta    dest+1
  14603.     dec    strptr        ; next raster
  14604.     bne    scr80e0a    ; done!
  14605.     rts
  14606.  
  14607. ;
  14608. ;    Scr80el1    zap from beginning of line to cursor
  14609. ;
  14610. scr80el1: 
  14611.     ldx    #0        ; get col,
  14612.     cpx    COLCRS        ; already at 0?
  14613.     beq    scr80e1z    ; yup, quit here
  14614.     ldy    ROWCRS        ; and row,
  14615.     jsr    scr80adrt    ; and figure out where we are
  14616.     ldx    COLCRS
  14617.     jsr    scr80adr    ; figure out even/odd of this coll
  14618.     stx    strptr+1    ; x has col / 2 in it
  14619.     lda    #8        ; init raster counter
  14620.     sta    strptr        ; handy temp
  14621. scr80e1a:
  14622.     lda    evenodd        ; $0F if on odd col
  14623.     bpl    scr80e1b    ; odd col, clear up to it
  14624.     ldy    strptr+1    ; get the byte pos
  14625.     and    (dest),y    ; mask it
  14626.     sta    (dest),y    ; and put it back
  14627. scr80e1b:
  14628.     ldx    strptr+1    ; remaining byte count
  14629.     beq    scr80e1d    ; zero? ok, done
  14630.     lda    #0
  14631.     jsr    fillx        ; fill that many
  14632. scr80e1d:
  14633.     lda    dest        ; get byte pointer
  14634.     clc
  14635.     adc    #40        ; next row please
  14636.     sta    dest
  14637.     lda    dest+1
  14638.     adc    #0
  14639.     sta    dest+1
  14640.     dec    strptr        ; next raster
  14641.     bne    scr80e1a    ; done!
  14642. scr80e1z:
  14643.     rts
  14644. ; 
  14645. ;    scr80el2 - zap current line
  14646. ;
  14647. scr80el2: 
  14648.     ldx    #0
  14649.     ldy    ROWCRS
  14650.     jsr    scr80adrt    ; get base addr of this row
  14651.     lda    #320\        ; clear 320 bytes
  14652.     sta    count
  14653.     lda    #320^
  14654.     sta    count+1
  14655.     jsr    clearn
  14656.     rts
  14657.  
  14658. scr80ind: 
  14659.     lda    top        ; init row counter
  14660.     sta    strptr        ; use this as a temp
  14661. scr80i1:
  14662.     jsr    comsta        ; this is slow, so make sure we
  14663.     jsr    flowco        ; pay attention to line
  14664.     ldx    #0        ; compute
  14665.     ldy    strptr        ;  row start addr
  14666.     iny
  14667.     jsr    scr80adrt
  14668.     lda    dest
  14669.     sta    source
  14670.     lda    dest+1
  14671.     sta    source+1
  14672.     ldx    #0
  14673.     ldy    strptr
  14674.     jsr    scr80adrt    ; and target row start addr
  14675.     lda    #320\        ; 320 bytes per row
  14676.     sta    count
  14677.     lda    #320^
  14678.     sta    count+1
  14679.     jsr    moven        ; move some
  14680.     inc    strptr        ; bump row counter
  14681.     lda    strptr
  14682.     cmp    bot        ; end yet?
  14683.     bcc    scr80i1        ; nope, do another row
  14684.     lda    ROWCRS        ; save row
  14685.     pha
  14686.     lda    bot
  14687.     sta    ROWCRS
  14688.     jsr    scr80el2    ; zap this line
  14689.     pla
  14690.     sta    ROWCRS        ; put row back
  14691.     rts
  14692.  
  14693. scr80ri:
  14694.     lda    bot        ; init row counter
  14695.     sta    strptr        ; use this as a temp
  14696. scr80r1:
  14697.     jsr    comsta        ; this is slow, so make sure we
  14698.     jsr    flowco        ; pay attention to line
  14699.     ldx    #0        ; compute
  14700.     ldy    strptr        ;  row start addr
  14701.     dey            ; row above's source
  14702.     jsr    scr80adrt
  14703.     lda    dest
  14704.     sta    source
  14705.     lda    dest+1
  14706.     sta    source+1
  14707.     ldx    #0
  14708.     ldy    strptr
  14709.     jsr    scr80adrt    ; and target row start addr
  14710.     lda    #320\        ; 320 bytes per row
  14711.     sta    count
  14712.     lda    #320^
  14713.     sta    count+1
  14714.     jsr    moven        ; move some
  14715.     dec    strptr        ; dec row counter
  14716.     lda    strptr        ; at top row yet?
  14717.     cmp    top
  14718.     bne    scr80r1        ; nope, do another row
  14719.     lda    ROWCRS        ; save row
  14720.     pha
  14721.     lda    top
  14722.     sta    ROWCRS
  14723.     jsr    scr80el2    ; zap this line
  14724.     pla
  14725.     sta    ROWCRS        ; put row back
  14726.     rts
  14727.  
  14728. ;
  14729. ;    slput:    put a string in the status line.  A,Y point to string.
  14730. ;        X is initial offset in status line
  14731. ;        terminates on EOL or nul. clears to end of stat line
  14732. ;
  14733. slput:
  14734.     sta    strptr        ; set up the string pointer
  14735.     sty    strptr+1
  14736.     ldy    #0
  14737. slp1:    lda    (strptr),y    ; get a byte
  14738.     beq    slp8        ; done!
  14739.     cmp    #ATEOL        ; eol?
  14740.     beq    slp9        ; yup, done
  14741.     cmp    #$60        ; lower case?
  14742.     bcs    slp2        ; yes, leave it alone
  14743.     sec
  14744.     sbc    #$20        ; offset into font
  14745. slp2:    sta    statline,x    ; stuff it in
  14746.     inx
  14747.     iny            ; next!
  14748.     jmp    slp1
  14749. slp8:
  14750.     txa            ; save x
  14751.     pha
  14752.     lda    #0        ; space, sort of
  14753. slp9:    sta    statline,x
  14754.     inx
  14755.     cpx    #40
  14756.     bcc    slp9
  14757.     pla
  14758.     tax
  14759.     rts            ; home
  14760.  
  14761. .SBTTL    Miscellaneous routines
  14762.  
  14763. ;
  14764. ;    These are miscellaneous routines used in many different places
  14765. ;
  14766.  
  14767. ;
  14768. ;    Moven - move (source) to (dest) for (count) bytes
  14769. ;
  14770. ;    Input: (count) - byte count to move
  14771. ;           (source) - address of source of memory move
  14772. ;           (dest) - address of destination of memory move
  14773. ;
  14774. ;    Output: Memory is moved
  14775. ;
  14776. ;    Registers Destroyed: A,X,Y
  14777. ;
  14778. moven:
  14779.     lda    count+1        ; more 256 byte chunks?
  14780.     beq    moven1        ; nope, go get the rest
  14781.     jsr    move256
  14782.     inc    source+1
  14783.     inc    dest+1
  14784.     dec    count+1
  14785.     bne    moven        ; try for more
  14786. moven1:
  14787.     ldx    count        ; any left?
  14788.     beq    moven2        ; nope, done
  14789.     jsr    movex        ; move that many
  14790. moven2:
  14791.     rts
  14792. ;
  14793. ; Move 256 bytes (source) to (dest)
  14794. ;
  14795. move256:
  14796.     ldy    #0
  14797. mov256a:
  14798.     lda    (source),y    ; move 1
  14799.     sta    (dest),y
  14800.     iny            ; bump
  14801.     bne    mov256a        ; if not wrapped, go back
  14802.     rts            ; done
  14803. ;
  14804. ; Move X bytes (source) to (dest)
  14805. ;
  14806. movex:
  14807.     ldy    #0
  14808. movexa:
  14809.     lda    (source),y    ; move 1
  14810.     sta    (dest),y
  14811.     iny            ; bump
  14812.     dex            ; dec count
  14813.     bne    movexa        ; non zero, go back for more
  14814.     rts
  14815. ;
  14816. ;    Move 8 * (x) bytes
  14817. ;    
  14818. move8:
  14819.     stx    count        ; lo byte of count
  14820.     lda    #0
  14821.     sta    count+1
  14822.     asl    count
  14823.     rol    count+1
  14824.     asl    count
  14825.     rol    count+1
  14826.     asl    count
  14827.     rol    count+1
  14828.     jmp    moven
  14829.  
  14830. ;
  14831. ;    clearn - clear (dest) for (count)
  14832. ;
  14833. ;    Input: (count) - byte count to fill
  14834. ;           (dest) - address of destination of memory move
  14835. ;
  14836. ;    Output: Memory is cleared
  14837. ;
  14838. ;    Registers Destroyed: A,X,Y
  14839. ;
  14840.  
  14841. clearn:    lda #0            ; clear memory by filling with $00
  14842.     jsr filln
  14843.     rts
  14844.     
  14845. ;
  14846. ;    Filln - fill (dest) for (count) with what's in A
  14847. ;
  14848. ;    Input: (count) - byte count to fill
  14849. ;           A - Byte to fill memory with
  14850. ;           (dest) - address of destination of memory move
  14851. ;
  14852. ;    Output: Memory is filled
  14853. ;
  14854. ;    Registers Destroyed: A,X,Y
  14855. ;
  14856. filln:
  14857.     ldx    count+1        ; more 256 byte chunks?
  14858.     beq    filln1        ; nope, go get the rest
  14859.     jsr    fill256
  14860.     inc    source+1
  14861.     inc    dest+1
  14862.     dec    count+1
  14863.     bne    filln        ; try for more
  14864. filln1:
  14865.     ldx    count        ; any left?
  14866.     beq    filln2        ; nope, done
  14867.     jsr    fillx        ; move that many
  14868. filln2:
  14869.     rts
  14870.  
  14871. ;
  14872. ; fill 256 bytes (dest)
  14873. ;
  14874. fill256:
  14875.     ldy    #0
  14876. fil256a:
  14877.     sta    (dest),y
  14878.     iny            ; bump
  14879.     bne    fil256a        ; if not wrapped, go back
  14880.     rts            ; done
  14881. ;
  14882. ; fill X bytes (dest)
  14883. ;
  14884. fillx:
  14885.     ldy    #0
  14886. fillxa:
  14887.     sta    (dest),y
  14888.     iny            ; bump
  14889.     dex            ; dec count
  14890.     bne    fillxa        ; non zero, go back for more
  14891.     rts
  14892.  
  14893. ;
  14894. ;    Case - Pascal like case function
  14895. ;
  14896. ;    Input: Y - Case statement to select
  14897. ;               The addresses of the routines to select are compiled inline
  14898. ;
  14899. ;    Registers Destroyed: X, Y
  14900. ;
  14901. ;    this routine transfers controll to a routine selected by the X register
  14902. ;
  14903.  
  14904. case:    tax            ; preserve a-reg across case statement
  14905.     pla            ; get lo bype of case list
  14906.     sta source        ; save it
  14907.     pla            ; get hi byte of case list
  14908.     sta source+1        ; save it
  14909.     tya            ; put case selector into a-reg
  14910.     sec            ; add one half
  14911.     rol a            ; and multiply by two
  14912.     tay            ; put (2*case_selector)+1 into y-reg
  14913.     lda (source),y        ; get lo byte of routine to go to
  14914.     sta dest        ; save it
  14915.     iny            ; prepare to get hi byte of routines address
  14916.     lda (source),y        ; get hi byte of routines address
  14917.     sta dest+1        ; save it
  14918.     txa            ; preserve a-reg across case statement
  14919.     jmp (dest)        ; go to appropriate
  14920.  
  14921. anyrts:    rts            ; a handy return from subroutine instruction
  14922. anybrk:    brk            ; a handy break instruction
  14923.  
  14924.     
  14925. ;
  14926. ; Set the OS's display list cells.
  14927. ; This may need to be done without interrupts or something zzz
  14928. ;
  14929. setdlist:
  14930.     ldx    #1
  14931.     stx    CRITIC        ; say we're doing something critical
  14932.     ldx    SDMCTL        ; get old DMACTL value
  14933.     stx    dest        ; save it here for a bit
  14934.     ldx    #0
  14935.     stx    DMACTL        ; and whack the real one while
  14936.     sta    SDLSTL        ;  we indulge in some sleight of hand
  14937.     sty    SDLSTH
  14938.     ldx    dest        ; get old dma ctrl value back
  14939.     stx    DMACTL
  14940.     dec    CRITIC
  14941.     rts
  14942. ;
  14943.  
  14944. ;end.asm: =    *
  14945. .SBTTL    Data for the screen package
  14946.  
  14947. scraedl: .word    0    ; the original display list addr for E:
  14948. scraec1: .byte    0    ; original color1 value
  14949. scraec2: .byte    0    ; original color2 value
  14950. scraec4: .byte    0    ; original color4 (background) value
  14951. scraer:    .byte    0    ; original cursor row value
  14952. scr40dl: .word    dlist    ; display list addr for 40/80 col screen
  14953. scr80dl: .word    dlist    ; display list addr for 80 col
  14954.  
  14955. panval:    .byte    0    ; pan offset for 40/80 mode
  14956.  
  14957. backclr: .byte    $0A    ; background color, grey, hi lum
  14958. foreclr: .byte    $02    ; foreground color, grey lo lum
  14959. ;altclr:    .byte    $ff    ; alternate color
  14960. bordclr: .byte    $08    ; border color, grey, med lum
  14961. ;
  14962. top:    .byte    $FF    ; top of scrolling area
  14963. bot:    .byte    $FF    ; bottom of scrolling area
  14964. vt100gr    =    *    ; graphic rendition params for vt100 emulation
  14965. alternt: .byte    $FF    ; $00=normal color, $01=alternate color
  14966.     .byte    $FE    ; filer for vt100 emulation
  14967.     .byte    $FE    ; filer for vt100 emulation
  14968. underln: .byte    $FF    ; $00=underline off, $ff=underline on
  14969. flash:    .byte    $FF    ; $00=normal text, $01=flashing text
  14970.     .byte    $FE    ; filler for vtt100 emulation
  14971. reverse: .byte    $FF    ; $00=reverse off, $ff=reverse on
  14972. wrap:    .byte    $FF    ; $01=no automatic wrapping, $00=use wrapping
  14973. altcs:    .byte    0    ; [jrd] alternate char set switch for vt100
  14974. csg0:    .byte    csascii    ; [jrd] G0 is normal ascii
  14975. csg1:    .byte    csgraf    ; [jrd] G1 is graphics
  14976. cntdown: .byte    $FF    ; countdown timer
  14977. curabrt: .byte    $FF    ; $00=cursor disabled.  Incremented & decremented.
  14978. curstat: .byte    $FF    ; $00=cursor light now, $01=cursor dark now
  14979. evenodd: .byte    $FF    ; $f0=cursor on even column, $0f=cursor on odd column
  14980. save1:    .byte    $FF    ; screen save area #1
  14981. save2:    .byte    $FF    ; screen save area #2
  14982. save3:    .byte    $FF    ; screen save area #3
  14983. save4:    .byte    $FF    ; screen save area #4
  14984. save5:    .byte    $FF    ; screen save area #5
  14985. save6:    .byte    $FF    ; screen save area #6
  14986.  
  14987. ;.SBTTL    Data for the vt100 emulation package
  14988.  
  14989. vt100st: .byte    $FF    ; parser state
  14990. vt100pt: .byte    $FF    ; parameter pointer
  14991.  
  14992. ;
  14993. ; Screen mem chunks must be on a 4k bound.  
  14994. ; Given the size of this thing, the best we can do is to end up
  14995. ; with scrmemlo at $9000. If it's higher than that, we'll clobber
  14996. ; the OS.  Beware when adding things to this code!
  14997. ;
  14998.  
  14999.     *=    *|$FFF+1    ; go to next 4k bound
  15000. scrmemlo: .blkb    3840        ; lo half of graphics screen
  15001. ;
  15002. ; the display list area for 40/80 col mode.  max size is 3 (preamble) + 
  15003. ;  3 (first graphics) + 95 (rest of graphics first half) + 
  15004. ;  3 + 95 + 3 (status line) + 3 (branch back)
  15005. ;
  15006. dlist:    .blkb    256        ; room for disp list, gets us to next 4k
  15007. scrmemhi: .blkb    3840        ; hi half of screen mem
  15008. statline: .blkb    40    ; status line for terminal screens
  15009. ;
  15010. ; vt100 tabstop map
  15011. ;
  15012. tabstop: .blkb    80
  15013. ;
  15014. ; scratch area for vt100 stuff
  15015. ;
  15016. freemem: .blkb    $20
  15017. ;
  15018. ; Storage for font mem in 40/80 mode
  15019. ;
  15020. font40    =    scrmemhi
  15021. ;
  15022. ; that's it!
  15023. ;
  15024.