?login_element?

Subversion Repositories NedoOS

Rev

Rev 672 | Details | Compare with Previous | Last modification | View Log | RSS feed

Rev Author Line No. Line
8 dimkam 1
functionslist
2
        dw func_rnd
3
        db "$rnd",0
4
 
344 alone 5
        dw -1 ; ⠡ 㭪権
8 dimkam 6
 
7
getval_function
8
;hl'=text
9
        call eatword
10
        ld hl,functionslist ;list of internal commands
11
getval_function0
12
        ld c,(hl)
13
        inc hl
344 alone 14
        ld b,(hl) ; 楤, ᮮ⢥饩 ⮩ 
8 dimkam 15
        inc hl
16
        ld a,b
17
        cp -1
91 demige 18
        jp z,fail_syntax ;ret z ;jr z,strcpexec_tryrun ;a!=0: no such internal command
8 dimkam 19
        ld de,wordbuf
20
        push hl
21
        call strcp
22
        pop hl
23
        jr nz,getval_function_fail
24
        ld h,b
25
        ld l,c
26
        jp (hl) ;run internal command
27
getval_function_fail
344 alone 28
        ld b,-1 ;⮡ 筮  ନ
8 dimkam 29
        xor a
344 alone 30
        cpir ; 易⥫쭮
8 dimkam 31
        jr getval_function0
32
 
33
commandslist
34
        dw cmd_for
35
        db "for",0
36
        dw cmd_next
37
        db "next",0
38
 
39
        dw cmd_clear
40
        db "clear",0
41
        dw cmd_new
42
        db "new",0
43
        dw cmd_quit
44
        db "quit",0
45
        dw cmd_run
46
        db "run",0
47
        dw cmd_goto
48
        db "goto",0
49
        dw cmd_edit
50
        db "edit",0
51
        dw cmd_list
52
        db "list",0
53
        dw cmd_save
54
        db "save",0
107 demige 55
        dw cmd_savecode
56
        db "savecode",0
8 dimkam 57
        dw cmd_load
58
        db "load",0
107 demige 59
        dw cmd_loadcode
60
        db "loadcode",0
8 dimkam 61
        dw cmd_system
62
        db "system",0
63
        dw cmd_pause
64
        db "pause",0
65
 
66
        dw cmd_let
67
        db "let",0
68
        dw cmd_dim
69
        db "dim",0
70
        dw cmd_print
71
        db "print",0
72
        dw cmd_cls
73
        db "cls",0
74
        dw cmd_gfx
75
        db "gfx",0
76
        dw cmd_plot
77
        db "plot",0
78
        dw cmd_line
79
        db "line",0
80
 
81
        dw cmd_if
82
        db "if",0
83
        dw cmd_then
84
        db "then",0
85
        dw cmd_colon
86
        db ":",0
87
        dw cmd_rem
88
        db "rem",0
89
 
344 alone 90
        dw -1 ; ⠡ 
8 dimkam 91
 
92
docmd
93
;hl'=text
94
        exx
95
        push hl
576 alone 96
        ld a,(curgfx)
97
        cp 6 ;textmode
98
        jr z,docmd_nogfx
99
        GET_KEY ;from BDOS
100
        jr docmd_nogfxq
101
docmd_nogfx
102
        GETKEY_ ;from stdin
103
docmd_nogfxq
8 dimkam 104
        pop hl
105
        exx
116 alone 106
        cp key_esc
8 dimkam 107
        jp z,endbreak
108
        call eatword
109
        ld hl,commandslist ;list of internal commands
110
strcpexec0
111
        ld c,(hl)
112
        inc hl
344 alone 113
        ld b,(hl) ; 楤, ᮮ⢥饩 ⮩ 
8 dimkam 114
        inc hl
115
        ld a,b
116
        cp -1
91 demige 117
        jp z,fail_syntax ;ret z ;jr z,strcpexec_tryrun ;a!=0: no such internal command
8 dimkam 118
        ld de,wordbuf
119
        push hl
120
        call strcp
121
        pop hl
122
        jr nz,strcpexec_fail
123
        ld h,b
124
        ld l,c
125
        jp (hl) ;run internal command
126
strcpexec_fail
344 alone 127
        ld b,-1 ;⮡ 筮  ନ
8 dimkam 128
        xor a
344 alone 129
        cpir ; 易⥫쭮
8 dimkam 130
        jr strcpexec0
131
 
132
eat
344 alone 133
;hl'=
8 dimkam 134
        exx
135
        inc hl
136
        call skipspaces
137
        exx
138
        ret
139
 
140
eatword
141
        exx
142
        ld de,wordbuf
107 demige 143
        call getword
344 alone 144
 ;६ ᫮  (HL)-> wordbuf
107 demige 145
        call skipspaces
344 alone 146
 ;  (HL) ய᪠ ஡
8 dimkam 147
        exx
148
        ret
149
 
150
eatclosebracket
151
        exx
152
        ld a,(hl)
153
        exx
154
        cp ')'
91 demige 155
        jp nz,fail_syntax
8 dimkam 156
        jp eat
157
 
158
eateq
159
        exx
160
        ld a,(hl)
161
        exx
162
        cp '='
91 demige 163
        jp nz,fail_syntax
8 dimkam 164
        jp eat
165
 
166
eatcomma
167
        exx
168
        ld a,(hl)
169
        exx
170
        cp ','
91 demige 171
        jp nz,fail_syntax
8 dimkam 172
        jp eat
107 demige 173
 
8 dimkam 174
cmd_pause
175
        exx
176
        push hl
576 alone 177
        ld a,(curgfx)
178
        cp 6 ;textmode
179
        jr z,cmd_pause_nogfx
180
        YIELDGETKEYLOOP ;from BDOS
181
        jr cmd_pause_nogfxq
182
cmd_pause_nogfx
183
        call yieldgetkeyloop ;from stdin
184
cmd_pause_nogfxq
8 dimkam 185
        pop hl
186
        exx
187
        ret
188
 
189
cmd_gfx
1518 alone 190
        call getexpr_dehl
8 dimkam 191
        exx
192
        push hl
193
        exx
1518 alone 194
        ld a,l
8 dimkam 195
        and 7
576 alone 196
        ld e,a
197
         ld (curgfx),a
672 alone 198
         cp 6
199
         jr nz,$+4
200
          ld e,-1 ;disable gfx (out: e=old gfxmode)
8 dimkam 201
        OS_SETGFX
202
        pop hl
203
        exx
204
        ret
205
 
206
getexprcolor
207
;out: a=color = %33210210
1518 alone 208
        call getexpr_dehl
209
        ld a,l
8 dimkam 210
        and 7
211
        ld d,a
1518 alone 212
        ld a,l
8 dimkam 213
        and 15
214
        add a,a
215
        add a,a
216
        add a,a
217
        or d ;%.3210210
218
        rlca
219
        rlca ;%210210.3, CY=3
220
        rra  ;%3210210., CY=3
221
        rra  ;%33210210
222
        ret
223
 
224
cmd_line
344 alone 225
;hl'=
8 dimkam 226
;line x2,y2,color
1518 alone 227
        call getexpr_dehl
228
        ld (cmd_line_x2),hl
8 dimkam 229
        call eatcomma
1518 alone 230
        call getexpr_dehl
231
        ld (cmd_line_y2),hl
8 dimkam 232
        call eatcomma
233
        call getexprcolor ;a=color = %33210210
234
 
235
        push af ;color
236
        call setpgs_scr
237
        pop af ;color
238
        ld bc,(cmd_plot_x)
239
        ld de,(cmd_plot_y)
240
cmd_line_x2=$+2
241
        ld ix,0
242
        ld (cmd_plot_x),ix
243
cmd_line_y2=$+1
244
        ld hl,0
245
        ld (cmd_plot_y),hl
344 alone 246
;bc=x ( ᪮ ࠭,    ⥫)
247
;de=y ( ᪮ ࠭,    ⥫)
8 dimkam 248
;ix=x2
249
;hl=y2
250
;a=color = %332103210
251
        exx
252
        push hl
253
        exx
254
        call shapes_line
255
        ;exx
256
        pop hl
257
        exx
258
        jp restorebasicpages
259
 
260
cmd_plot
344 alone 261
;hl'=
8 dimkam 262
;plot x,y,color
1518 alone 263
        call getexpr_dehl
264
        ld (cmd_plot_x),hl
8 dimkam 265
        call eatcomma
1518 alone 266
        call getexpr_dehl
267
        ld (cmd_plot_y),hl
8 dimkam 268
        call eatcomma
269
        call getexprcolor
115 alone 270
        ;ld lx,a ;lx=color = %33210210
271
        ld (prpixel_color_l),a
272
        ld (prpixel_color_r),a
8 dimkam 273
cmd_plot_x=$+1
274
        ld hl,0
275
        ld bc,320
276
        or a
277
        sbc hl,bc
278
        add hl,bc
279
        ret nc
280
        ex de,hl
281
 
282
cmd_plot_y=$+1
283
        ld hl,0
284
        ld bc,200
285
        or a
286
        sbc hl,bc
287
        add hl,bc
288
        ret nc
289
;l=y
290
        call setpgs_scr
115 alone 291
         ld b,d
292
         ld c,e
293
        ld e,l
294
        ld d,0
295
;bc=x ;de
296
;e=y ;c
297
;[lx=color = %33210210]
8 dimkam 298
        call prpixel
299
        jp restorebasicpages
300
 
301
setpgs_scr
512 alone 302
;setpgs_scr_low=$+1
555 alone 303
        ld a,(user_scr0_low) ;ok
8 dimkam 304
        SETPG32KLOW
512 alone 305
;setpgs_scr_high=$+1
555 alone 306
        ld a,(user_scr0_high) ;ok
8 dimkam 307
        SETPG32KHIGH
308
        ret
309
 
310
 
311
scrbase=0x8000
312
shapes_line
344 alone 313
;bc=x ( ᪮ ࠭,    ⥫)
314
;de=y ( ᪮ ࠭,    ⥫)
8 dimkam 315
;ix=x2
316
;hl=y2
317
;a=color = %332103210
115 alone 318
        ;ld (line_pixel_color),a
319
        ld (prpixel_color_l),a
320
        ld (prpixel_color_r),a
8 dimkam 321
        or a
322
        sbc hl,de
323
        add hl,de
324
        jp p,shapes_line_noswap
325
        ex de,hl ;y <-> y2
326
        push ix
327
        push bc
328
        pop ix
329
        pop bc ;x <-> x2
330
shapes_line_noswap
331
        or a
332
        sbc hl,de ;dy >= 0
333
        push hl ;dy
334
        push ix
335
        pop hl
336
        sbc hl,bc
337
        push hl ;dx
338
        exx
339
        pop bc ;dx
340
        ld a,#03 ;inc bc
341
        jp p,shapes_line_nodec
342
        xor a
343
        sub c
344
        ld c,a
345
        sbc a,b
346
        sub c
347
        ld b,a ;dx >= 0
348
        ld a,#0b ;dec bc
349
shapes_line_nodec
350
        pop de ;dy
344 alone 351
;a= inc/dec bc
352
;bc'=x ( ᪮ ࠭,    ⥫)
353
;de'=y ( ᪮ ࠭,    ⥫)
8 dimkam 354
;bc=dx
355
;de=dy
356
        ex de,hl
357
        or a
358
        sbc hl,bc
359
        add hl,bc
360
        ex de,hl
361
        jr nc,shapes_linever ;dy>=dx
362
        ld hy,b
363
        ld ly,c ;counter=dx
344 alone 364
        ;inc iy ;inc hy ;㥬,  ᫥ ᥫ (⥭  横)
8 dimkam 365
        ld h,b
366
        ld l,c
367
        sra h
344 alone 368
        rr l ;ym=dx div 2 ;TODO  ᫨ dx<0?
8 dimkam 369
         ;xor a
370
         ;sub l
371
         ;ld l,a
372
         ;sbc a,h
373
         ;sub l
374
         ;ld h,a ;mym=256-(dx div 2)
375
        exx
376
        ld (shapes_lineincx),a
377
;bc=x
378
;de=y
379
;hl'=xm
380
;bc'=dx
381
;de'=dy
382
shapes_linehor0
383
        call line_pixel
384
shapes_lineincx=$
385
        inc bc ;x+1        
386
        exx
387
        ;add hl,de ;mym+dy
388
        or a
389
        sbc hl,de ;ym-dy
390
        exx
391
        jr nc,shapes_linehor1
392
        inc de ;y+1
393
        exx
394
        ;or a
395
        ;sbc hl,bc ;mym-dx
396
        add hl,bc ;ym+dx
397
        exx
398
shapes_linehor1
399
        dec iy
400
        ld a,hy
401
        rla
402
        jp nc,shapes_linehor0
403
        ret
404
shapes_linever
405
        ld hy,d
406
        ld ly,e ;counter=dy
344 alone 407
        ;inc iy ;inc hy ;㥬,  ᫥ ᥫ (⥭  横)
8 dimkam 408
        ld h,d
409
        ld l,e
410
        sra h
411
        rr l
412
         ;xor a
413
         ;sub l
414
         ;ld l,a
415
         ;sbc a,h
416
         ;sub l
417
         ;ld h,a ;mxm=256-(dy div 2)
418
        exx
419
        ld (shapes_lineincx2),a
420
;bc=x
421
;de=y
422
;hl'=xm
423
;bc'=dx
424
;de'=dy
425
shapes_linever0
426
        call line_pixel
427
        inc de ;y+1
428
        exx
429
        ;add hl,bc ;mxm+dx
430
        or a
344 alone 431
        sbc hl,bc ;xm-dx ;TODO  ᫨ dx<0?
8 dimkam 432
        exx
433
        jr nc,shapes_linever1
434
shapes_lineincx2=$
435
        inc bc ;x+1
436
        exx
437
        ;or a
438
        ;sbc hl,de ;mxm-dy
439
        add hl,de ;xm+dy
440
        exx
441
shapes_linever1
442
        dec iy
443
        ld a,hy
444
        rla
445
        jp nc,shapes_linever0
446
        ret
447
 
448
line_pixel
344 alone 449
;bc=x (  ⥫)
450
;de=y (  ⥫)
8 dimkam 451
        ld hl,199
452
        or a
453
        sbc hl,de ;y
454
        ret c ;y>199
455
        ld hl,319
456
        or a
457
        sbc hl,bc ;x
458
        ret c ;x>319
115 alone 459
        ;push bc
460
        ;push de
461
;        push ix
462
        ;ld a,e
463
        ;ld d,b
464
        ;ld e,c ;de=x
465
        ;ld c,a ;c=y
466
;line_pixel_color=$+2
467
;        ld lx,0
344 alone 468
;de=x ( )
469
;c=y (bc  )
8 dimkam 470
;lx=color = %33210210
115 alone 471
        ;call prpixel
472
;        pop ix
473
        ;pop de
474
        ;pop bc
475
        ;ret
476
prpixel
344 alone 477
;bc=x ( )
478
;e=y (de  )
115 alone 479
;[lx=color = %33210210]
480
       ;ld a,d
481
        ld l,e
482
        ;ld h,0
483
        ;ld d,scrbase/256/8 ;h
484
        ld h,scrbase/256/32
485
        add hl,hl
486
        add hl,hl
487
        add hl,de
488
        add hl,hl
489
        add hl,hl
490
        add hl,hl ;y*40 + scrbase
491
       ;ld d,a
492
prpixel_cury
344 alone 493
;bc=x ( )
115 alone 494
;hl=addr(y)
495
;lx=color = %33210210
496
        ld a,b
497
        rra
498
        ld a,c
499
        rra
500
        jr c,prpixel_r
501
        rra
502
        jr nc,$+4
503
        set 6,h
504
        rra
505
        jr nc,$+4
506
        set 5,h
1518 alone 507
        and 0b00111111
115 alone 508
        add a,l
509
        ld l,a
510
        adc a,h
511
        sub l
512
        ld h,a
513
prpixel_color_l=$+1
514
        ld a,0;lx
515
        xor (hl)
1518 alone 516
        and 0b01000111 ;keep left pixel 
115 alone 517
        xor (hl) ;right pixel from screen
518
        ld (hl),a
8 dimkam 519
        ret
115 alone 520
prpixel_r
521
        rra
522
        jr nc,$+4
523
        set 6,h
524
        rra
525
        jr nc,$+4
526
        set 5,h
1518 alone 527
        and 0b00111111
115 alone 528
        add a,l
529
        ld l,a
530
        adc a,h
531
        sub l
532
        ld h,a
533
prpixel_color_r=$+1
534
        ld a,0;lx
535
        xor (hl)
1518 alone 536
        and 0b10111000 ;keep right pixel 
115 alone 537
        xor (hl) ;left pixel from screen
538
        ld (hl),a
539
        ret
540
 
8 dimkam 541
cmd_system
344 alone 542
;hl'=
8 dimkam 543
;system "command params"
1518 alone 544
        call getexpr_dehl
8 dimkam 545
        bit 7,c
91 demige 546
        jp z,fail_syntax
8 dimkam 547
        exx
548
        push hl
549
        exx
550
;hl = wordbuf = string
55 Alone 551
        ld de,curdir ;DE = Pointer to 64 byte (MAXPATH_sz!) buffer
8 dimkam 552
        OS_GETPATH
344 alone 553
        OS_SETSYSDRV ;TODO ⠫ cmd
8 dimkam 554
 
555
        ld de,tcmd
556
        OS_OPENHANDLE
557
        or a
91 demige 558
        jp nz,fail_fo
8 dimkam 559
        ld a,b
560
        ld (cmd_system_handle),a
561
        OS_NEWAPP
562
        or a
563
        jp nz,close_restoredir_fail
344 alone 564
;dehl= ࠭  0000,4000,8000,c000  ਫ, b=id, a=error
8 dimkam 565
        push bc ;b=id
566
 
567
        ld a,d
1518 alone 568
        SETPGC000
8 dimkam 569
        push de
570
        push hl
571
        ld hl,syscmdbuf
1518 alone 572
        ld de,0xc000+COMMANDLINE
8 dimkam 573
        ld bc,COMMANDLINE_sz
574
        ldir ;command line
575
        xor a
1518 alone 576
        ld (0xc000+COMMANDLINE+COMMANDLINE_sz-1),a ; 砩, ᫨ "cmd "+wordbuf  128 
8 dimkam 577
        pop hl
578
        pop de
579
cmd_system_handle=$+1
580
        ld b,0
581
        call readfile_pages_dehl
582
        call cmd_system_close_restoredir
583
 
584
        pop af ;a=id
585
        ld e,a
586
        push de
587
        OS_RUNAPP
588
        pop de
11 dimkam 589
        WAITPID
8 dimkam 590
        pop hl
591
        exx
592
        ret
593
 
594
cmd_system_close_restoredir
595
        ld a,(cmd_system_handle)
596
        ld b,a
597
        OS_CLOSEHANDLE
598
        ld de,curdir
599
        OS_CHDIR
600
        jp restorebasicpages
601
 
602
close_restoredir_fail
603
        call cmd_system_close_restoredir
91 demige 604
        jp fail_fo
8 dimkam 605
 
606
popret
607
        pop af
608
        ret
609
readfile_pages_dehl
610
        ld a,d
611
        push bc
1518 alone 612
        SETPGC000
8 dimkam 613
        pop bc
614
         ld a,e
615
         push af
616
        ld a,+(#c000+PROGSTART)/256
617
        call cmd_loadpage
618
        jr nz,popret
619
         pop af ;e
620
        call cmd_setpgloadpage
621
        ret nz
622
        ld a,h
623
        call cmd_setpgloadpage
624
        ret nz
625
        ld a,l
626
cmd_setpgloadpage
627
        push bc
1518 alone 628
        SETPGC000
8 dimkam 629
        pop bc
1518 alone 630
        ld a,0xc000/256
8 dimkam 631
cmd_loadpage
632
;a=loadaddr/256
633
;b=handle
634
;out: de=bytes read, NZ=end of file
635
;keeps hl,bc
636
        push bc
637
        push hl
638
        ld d,a
639
        ld e,0
640
        ld hl,0
641
        or a
642
        sbc hl,de
643
;B = file handle, DE = Buffer address, HL = Number of bytes to read
644
        push hl
645
        OS_READHANDLE
646
;HL = Number of bytes actually read, A=error(=0)
647
        ex de,hl
648
        pop hl
649
        or a
650
        sbc hl,de ;Number of bytes to read - Number of bytes actually read
651
        pop hl
652
        pop bc
653
        ret
654
 
655
 
656
tcmd
657
        db "cmd.com",0
658
 
659
 
107 demige 660
cmd_loadcode
344 alone 661
;hl'=
8 dimkam 662
;load "name.bas"
1518 alone 663
        call getexpr_dehl
8 dimkam 664
        bit 7,c
91 demige 665
        jp z,fail_syntax
8 dimkam 666
        call cmd_load_hl
344 alone 667
; 室  ret, ⮬   ணࠬ 㭨⮦
8 dimkam 668
        jp endofprog
669
 
670
cmd_load_hl
671
;hl = wordbuf = filename
672
        ;exx
673
        ;ld a,(hl)
674
        ;exx
675
        ;cp '"'
676
        ;jp nz,fail
677
        ;call readstr
678
        ;jp c,fail
679
;wordbuf = filename
680
        ;ld de,wordbuf ;de=drive/path/file
681
        ex de,hl
682
        OS_OPENHANDLE
683
;b=new file handle
684
        or a
91 demige 685
        jp nz,fail_fo
8 dimkam 686
        ld de,progmem
687
        ld hl,szprogmem
688
;B = file handle, DE = Buffer address, HL = Number of bytes to read
689
        push bc
690
        OS_READHANDLE
691
        pop bc
692
;HL = Number of bytes actually read, A=error
693
        ld de,progmem
694
        add hl,de
695
        ld (progend),hl
696
        OS_CLOSEHANDLE        
697
        call cmd_clear
698
        ret
699
 
107 demige 700
cmd_load
344 alone 701
;hl'=
107 demige 702
;load "name.bas"
1518 alone 703
        call getexpr_dehl
107 demige 704
        bit 7,c
705
        jp z,fail_syntax
706
        call cmd_load_text
344 alone 707
; 室  ret, ⮬   ணࠬ 㭨⮦
107 demige 708
        jp endofprog
709
 
91 demige 710
cmd_load_text
711
;hl = wordbuf = filename
712
        ;ld de,wordbuf ;de=drive/path/file
713
        ex de,hl
714
        OS_OPENHANDLE
715
;b=new file handle
716
        or a
717
        jp nz,fail_fo
718
 
719
read_next_str
720
        ld de,cmdbuf
721
        ld hl,1
722
read_fsmb
723
;B = file handle, DE = Buffer address, HL = Number of bytes to read
724
        push bc
725
        push de
726
        OS_READHANDLE
727
        pop de
728
        pop bc
729
        ld a,l
94 alone 730
        or a
344 alone 731
        jp z,endfile ;᫨  ⠫ =  䠩 - 室
94 alone 732
        ld a,(de)
91 demige 733
        cp 0x0A
344 alone 734
        jp z,end_read ;  ப ।  0x0A
91 demige 735
        ld a,(de)
94 alone 736
        cp 0x0D
344 alone 737
        jp z,read_fsmb ;  ண뢠 ᨬ  ⪨
91 demige 738
        inc de
739
        jp read_fsmb
740
 
741
end_read
742
        xor a
344 alone 743
        ld (de),a ;⠢ ନ  ப
107 demige 744
        ld hl,cmdbuf
745
 
94 alone 746
        ex de,hl
747
        ;or a
344 alone 748
        sbc hl,de ;塞  ப
749
        jp z, read_next_str ; ᫨  ப, ⠥ ᫥
750
        ex de,hl ;頥   hl=cmdbuf
751
        push bc ;  直 砩 ࠭塞 file handle,   祣...
91 demige 752
        call add_or_run_line
753
        pop bc
754
        jp read_next_str
755
 
756
endfile
757
        OS_CLOSEHANDLE
344 alone 758
        ld hl,cmdbuf;    ப ᫥ 㦥  䠩 
107 demige 759
        ld (hl),0
94 alone 760
        jp cmd_clear
91 demige 761
 
344 alone 762
cmd_savecode ; ਣ쭠 楤 ன 㧪 ணࠬ  䠩
763
;hl'=
8 dimkam 764
;save "name.bas"
1518 alone 765
        call getexpr_dehl
8 dimkam 766
        bit 7,c
91 demige 767
        jp z,fail_syntax
8 dimkam 768
        ;exx
769
        ;ld a,(hl)
770
        ;exx
771
        ;cp '"'
772
        ;jp nz,fail
773
        ;call readstr
774
        ;jp c,fail
775
;wordbuf = filename
776
        ;ld de,wordbuf ;de=drive/path/file
777
        ex de,hl
778
        OS_CREATEHANDLE
779
;b=new file handle
780
        or a
91 demige 781
        jp nz,fail_fo
8 dimkam 782
        ld hl,(progend)
783
        ld de,progmem
784
        ;or a
785
        sbc hl,de
786
;B = file handle, DE = Buffer address, HL = Number of bytes to write
787
        push bc
788
        OS_WRITEHANDLE
107 demige 789
        pop bc
790
        OS_CLOSEHANDLE
344 alone 791
        ld hl,cmdbuf ;   砫 
107 demige 792
        ld (hl),0
91 demige 793
        exx
107 demige 794
        ret
795
 
796
cmd_save
344 alone 797
;hl'=
107 demige 798
;save "name.bas"
1518 alone 799
        call getexpr_dehl
107 demige 800
        bit 7,c
801
        jp z,fail_syntax
802
        ex de,hl
803
;de=drive/path/file
804
        OS_CREATEHANDLE
805
        push bc ;filehandle
289 dimkam 806
        ;display cmd_save, " cmd_save"
807
        ;display cmdbuf, " cmdbuf"
107 demige 808
 
809
;b=new file handle
810
        or a
811
        jp nz,fail_fo
344 alone 812
;ଠ ப:  ப(,),  ப(,), ப(asciiz)
107 demige 813
        ld hl,progmem
814
save_lines0
815
        ld de,(progend)
816
        or a
817
        sbc hl,de
818
        add hl,de
819
        jr z,save_end
820
 
344 alone 821
        push hl ;஢ઠ  ⨥ ਪ
576 alone 822
        GETKEY_
91 demige 823
        pop hl
116 alone 824
        cp key_esc
107 demige 825
        jp z,endbreak
826
 
344 alone 827
        ld d, (hl) ; 㦠  DE  ப 
107 demige 828
        inc hl
829
        ld e, (hl)
830
        inc hl
831
 
344 alone 832
        push hl ; த ப
833
        push de ;   hex
834
        ld hl,cmdbuf ;  㧨  hl'  㤠  㦥 ⥪⮢  ப
835
        exx ;  hl' ⥯ 
836
        pop de ;   hex
837
        call prlinenum_tomem ; hl' 㤠, de   hex
91 demige 838
        exx
344 alone 839
        ex hl,de ; de  த cmdbuf
840
        pop hl; த ப
107 demige 841
 
344 alone 842
        ld a,' ' ; ஡
107 demige 843
        ld (de),a
844
        inc de
344 alone 845
        ld c,(hl) ; ப
107 demige 846
        inc hl
344 alone 847
        ld b,(hl) ; ப
107 demige 848
        inc hl
344 alone 849
        ldir      ;㥬  ப  de
107 demige 850
        ld a,0x0D
851
        ld (de),a
852
        inc de
853
        ld a,0x0A
854
        ld (de),a
855
        inc de
344 alone 856
        inc hl; ய᪠ ନ
107 demige 857
 
344 alone 858
        pop bc ; ⠥ filehandle
859
        push bc ;filehandle   ਣ
860
        push hl ;⠬ ᫥ ப
107 demige 861
        ld hl,cmdbuf
862
        ex hl,de
344 alone 863
        sbc hl,de ;  hl  稢襩 ⥪⮢ ப
864
        ld de,cmdbuf ;  de  ᠬ ப
107 demige 865
 
866
;B = file handle, DE = Buffer address, HL = Number of bytes to write
867
        OS_WRITEHANDLE
344 alone 868
        pop hl ; ᫥ ப
107 demige 869
        jr save_lines0
870
save_end
8 dimkam 871
        pop bc
91 demige 872
        OS_CLOSEHANDLE
107 demige 873
        ld hl,cmdbuf
344 alone 874
        ld (hl),0 ; 頥  ப
875
        exx ; hl'   砫 
8 dimkam 876
        ret
877
 
878
cmd_new
879
        ld hl,progmem
880
        ld (progend),hl
881
        call cmd_clear
882
        jp endofprog
883
 
884
cmd_clear
885
        ld hl,varmem
886
        ld (varend),hl
887
        ld hl,varindex_int
888
        ld de,varindex_int+1
889
        ld bc,511
890
        ld (hl),l;0
891
        ldir
892
        ret
893
 
894
cmd_rem
895
        jp gotonextline
896
 
897
cmd_for
344 alone 898
;hl'=
8 dimkam 899
;for i=1 to 10 step 2
344 alone 900
;ࠬ 横 (4+4(step)+4(to)+4(goto) )
8 dimkam 901
        exx
902
        ld a,(hl)
903
        exx
344 alone 904
        ld c,a ;
8 dimkam 905
        call eat
906
 
907
        ld a,c
908
        call findvar_index
909
        jr nz,cmd_for_nocreate
910
        ld hl,(varend)
911
        push hl
912
        ld de,4*4
913
        add hl,de
914
        ld (varend),hl
915
        pop de
916
;de=addr
917
        ld h,varindex_int/256
918
        ld l,c
919
        ld (hl),e
920
        inc h
921
        ld (hl),d
922
cmd_for_nocreate
923
 
924
        call eateq
925
        push bc
1518 alone 926
        call getexpr_dehl
8 dimkam 927
        pop bc
928
        ld a,c
929
        call setvar_int
930
 
931
        call eatword ;to
932
 
933
        push bc
1518 alone 934
        call getexpr_dehl
8 dimkam 935
        pop bc
1518 alone 936
        push de ;HSW
937
        push hl ;LSW
8 dimkam 938
        ld a,c
939
        call findvar_index
940
        ld de,4+4
941
        add hl,de
942
        pop de ;LSW
943
        ld (hl),e
944
        inc hl
945
        ld (hl),d
946
        inc hl
947
        pop de ;HSW
948
        ld (hl),e
949
        inc hl
950
        ld (hl),d
951
 
952
        call eatword ;step
953
 
954
        push bc
1518 alone 955
        call getexpr_dehl ;dehl=step
8 dimkam 956
        pop bc
957
 
94 alone 958
        ld a,h
8 dimkam 959
        or l
960
        or d
961
        or e
91 demige 962
        jp z,fail_syntax
8 dimkam 963
 
1518 alone 964
        push de ;HSW
965
        push hl ;LSW
8 dimkam 966
        ld a,c
967
        call findvar_index
968
        ld de,4
969
        add hl,de
970
        pop de ;LSW
971
        ld (hl),e
972
        inc hl
973
        ld (hl),d
974
        inc hl
975
        pop de ;HSW
976
        ld (hl),e
977
        inc hl
978
        ld (hl),d
979
 
980
        ld a,c
981
        call findvar_index
982
        ld de,4+4+4
983
        add hl,de
984
;currunline=$+1
985
        ;ld de,0
986
        ;inc de
987
        exx
988
        push hl
989
        exx
990
        pop de
991
        ld (hl),e
992
        inc hl
993
        ld (hl),d
994
        inc hl
995
        ld (hl),0
996
        inc hl
997
        ld (hl),0
998
 
999
        ret
1000
 
1001
cmd_next
344 alone 1002
;hl'=
8 dimkam 1003
;next i (i = i+step, if i<=to then goto...)
1004
        exx
1005
        ld a,(hl)
1006
        exx
344 alone 1007
        ld c,a ;
8 dimkam 1008
        call eat
1009
 
1010
        ld a,c
1011
        call findvar_index
91 demige 1012
        jp z,fail_syntax
8 dimkam 1013
 
1014
        push hl
1518 alone 1015
        ld c,(hl)
1016
        inc hl
1017
        ld b,(hl)
1018
        inc hl
8 dimkam 1019
        ld e,(hl)
1020
        inc hl
1021
        ld d,(hl)
1518 alone 1022
        inc hl ;debc = i
8 dimkam 1023
 
1024
        ld a,(hl)
1518 alone 1025
        add a,c
1026
        ld c,a
8 dimkam 1027
        inc hl
1028
        ld a,(hl)
1518 alone 1029
        adc a,b
1030
        ld b,a
8 dimkam 1031
        inc hl
1032
        ld a,(hl)
1518 alone 1033
        adc a,e
1034
        ld e,a
8 dimkam 1035
        inc hl
1036
        ld a,(hl)
1518 alone 1037
        adc a,d
1038
        ld d,a ;debc = i = i+step
8 dimkam 1039
 
1040
        ex (sp),hl
1518 alone 1041
        ld (hl),c
1042
        inc hl
1043
        ld (hl),b
1044
        inc hl
8 dimkam 1045
        ld (hl),e
1046
        inc hl
1047
        ld (hl),d
1048
        inc hl
1049
        pop hl
1050
 
1051
        bit 7,(hl) ;step>=0?
1052
        push af
1053
        inc hl
1054
 
1055
;to>=i?
1056
        ld a,(hl)
1518 alone 1057
        sub c
1058
        ld c,a
8 dimkam 1059
        inc hl
1060
        ld a,(hl)
1518 alone 1061
        sbc a,b
1062
        ld b,a
8 dimkam 1063
        inc hl
1064
        ld a,(hl)
1518 alone 1065
        sbc a,e
1066
        ld e,a
8 dimkam 1067
        inc hl
1068
        ld a,(hl)
1518 alone 1069
        sbc a,d
1070
        ld d,a
8 dimkam 1071
        inc hl
1518 alone 1072
;debc = to-i
344 alone 1073
;TODO  ९
8 dimkam 1074
        pop af ;NZ = step<0
1518 alone 1075
        call nz,negdebc
8 dimkam 1076
;i<=to (to-i >= 0) - continue loop
1518 alone 1077
        bit 7,d ;Z = to-i>=0
8 dimkam 1078
        ret nz ;end of loop
1518 alone 1079
        call getint ;hl= ᫥ for ;뫮 dehl= ப
8 dimkam 1080
        exx
1081
        ret
1082
        ;jp cmd_goto_ok
1083
 
1084
cmd_dim
344 alone 1085
;hl'=
1086
;dim a(15) - 㬥 ⮢  
8 dimkam 1087
        exx
1088
        ld a,(hl)
1089
        exx
344 alone 1090
        ld c,a ;
8 dimkam 1091
        call eat
1092
 
1093
        ld a,c
1094
        call findvar_array
344 alone 1095
        jp nz,fail_syntax ;㦥  ⠪ ६
8 dimkam 1096
 
1097
        exx
1098
        ld a,(hl)
1099
        exx
1100
        cp '('
91 demige 1101
        jp nz,fail_syntax
8 dimkam 1102
        call eat
1103
        push bc
1518 alone 1104
        call getexpr_dehl
8 dimkam 1105
        pop bc
1106
        call eatclosebracket
1107
 
1518 alone 1108
        ex de,hl ;de=size
8 dimkam 1109
 
1110
;c=name (char)
1111
        ld hl,(varend)
1112
        push hl
1113
        ld (hl),e
1114
        inc hl
1115
        ld (hl),d
1116
        inc hl
1117
        add hl,de
1118
        add hl,de
1119
        add hl,de
1120
        add hl,de
1121
        ld (varend),hl
1122
        pop de
1123
;de=addr
1124
        ld h,varindex_int/256
1125
        ld l,c
1126
        ld (hl),e
1127
        inc h
1128
        ld (hl),d
1129
        ret
1130
 
1131
cmd_edit
344 alone 1132
;hl'=
1518 alone 1133
        call getexpr_dehl
1134
        ex de,hl
1135
        call findline ;de 
8 dimkam 1136
        ld a,(hl)
1137
        cp d
91 demige 1138
        jp nz,fail_syntax
8 dimkam 1139
        inc hl
1140
        ld a,(hl)
1141
        cp e
91 demige 1142
        jp nz,fail_syntax
344 alone 1143
        ;hl= ப,    + 1
8 dimkam 1144
        inc hl
1145
        inc hl
1146
        inc hl
1147
 
1148
        push hl
1149
        exx
1150
        ld hl,cmdbuf
1151
        exx
1518 alone 1152
        call prlinenum_tomem ;de 
8 dimkam 1153
        exx
1154
        ld (hl),' '
1155
        inc hl
1156
        push hl
1157
        exx
344 alone 1158
        pop de ;cmdbuf+
1159
        pop hl ;hl= ப (⥪)
8 dimkam 1160
 
1161
        push hl
1162
        call strlen
1163
        ld b,h
1164
        ld c,l
344 alone 1165
        inc bc ;  ନ஬
8 dimkam 1166
        pop hl
1167
 
1168
        ;ld de,cmdbuf
1169
        ;ld bc,MAXCMDSZ+1
1170
        ldir
1171
        jp endofedit
1172
 
1173
cmd_then
1174
cmd_colon
1175
        ret
1176
 
1177
cmd_list
344 alone 1178
; ப(,),  ப(,), ப(asciiz)
1179
        ld hl,progmem ; progmem ⠭  砫  ணࠬ
8 dimkam 1180
list_lines0
344 alone 1181
        ld de,(progend) ;   progend 室 ६ 㪠뢠    ணࠬ
8 dimkam 1182
        or a
1183
        sbc hl,de
1184
        add hl,de
1185
        ret z
1186
 
344 alone 1187
        push hl ;஢ઠ  ⨥ ਪ
576 alone 1188
        GETKEY_
8 dimkam 1189
        pop hl
116 alone 1190
        cp key_esc
8 dimkam 1191
        jp z,endbreak
1192
 
1193
        ld d,(hl)
1194
        inc hl
344 alone 1195
        ld e,(hl) ; ப
8 dimkam 1196
        inc hl
1197
        push hl
344 alone 1198
        call prword_de ; ப
8 dimkam 1199
        ld a,' '
576 alone 1200
        PRCHAR_
8 dimkam 1201
        pop hl
107 demige 1202
 
8 dimkam 1203
        ;ld e,(hl)
1204
        inc hl
344 alone 1205
        ;ld d,(hl) ; ப
8 dimkam 1206
        inc hl
1207
        call prtext ;hl after terminator
1208
        call prcrlf
107 demige 1209
 
8 dimkam 1210
        jr list_lines0
1211
 
1212
 
1213
        macro STRPUSH
1214
;hl=string addr
1215
        xor a
1216
        push af
1217
         ld a,(hl)
1218
         inc hl
1219
         or a
1220
         push af
1221
        jr nz,$-4
1222
        pop af
344 alone 1223
; ⥪  \0, ⥪ ( ନ)
8 dimkam 1224
        endm
1225
 
1226
        macro STRPOP
1227
;hl=string addr
1228
        ld d,h
1229
        ld e,l
1230
         pop af
1231
         ld (hl),a
1232
         inc hl
1233
         or a
1234
        jr nz,$-4
1235
        ex de,hl
1236
        call strmirror
1237
        endm
1238
 
1239
strmirror
1240
;hl=string addr
1241
        ld d,h
1242
        ld e,l
1243
        call strlen
1244
        ld b,h
1245
        ld c,l
344 alone 1246
;de=砫, bc=hl=
8 dimkam 1247
        ;ld h,b
1248
        ;ld l,c
344 alone 1249
        add hl,de ;hl=+1
8 dimkam 1250
        srl b
1251
        rr c ;bc=wid/2
1252
mirrorbytes0
1253
        dec hl
1254
        ld a,(de)
1255
        ldi
1256
        dec hl
1257
        ld (hl),a
1258
        jp pe,mirrorbytes0
1259
        ret
1260
 
1261
 
1262
cmd_let
344 alone 1263
;hl'=
8 dimkam 1264
        exx ;ld hl,(execcmd_pars)
1265
        ld a,(hl)
1266
        exx
1267
        ld c,a
1268
        exx
1269
        inc hl ;call eat
1270
        ld a,(hl)
1271
        exx
1272
        cp '$'
1273
        jr z,cmd_let_str
1274
        cp '('
1275
        jr z,cmd_let_array
344 alone 1276
;hl'=
8 dimkam 1277
        call eatspaces
1278
        call eateq
1279
        ld a,c
1280
        call findvar_int
1281
        jr nz,cmd_let_createq
1282
        ld a,c
1283
        call addvar_int
1284
cmd_let_createq
1285
        push bc
1518 alone 1286
        call getexpr_dehl ;dehl=value
344 alone 1287
        pop bc ; ࠦ   c
8 dimkam 1288
        ld a,c
344 alone 1289
        call setvar_int ;TODO  ᪠ ६ ன ࠧ
8 dimkam 1290
        ret
1291
 
1292
cmd_let_array
1293
        call eat ;skip '(' and spaces
1294
        push bc
1518 alone 1295
        call getexpr_dehl
8 dimkam 1296
        pop bc
1297
        call eatclosebracket
1298
        ld a,c
1299
        call findvar_int
91 demige 1300
        jp z,fail_syntax
8 dimkam 1301
        call indexarray
344 alone 1302
        push hl ; 
8 dimkam 1303
        call eateq
1518 alone 1304
        call getexpr_dehl
8 dimkam 1305
        ld b,h
1518 alone 1306
        ld c,l ;debc
344 alone 1307
        pop hl ; 
1518 alone 1308
        ld (hl),c
1309
        inc hl
1310
        ld (hl),b
1311
        inc hl
8 dimkam 1312
        ld (hl),e
1313
        inc hl
1314
        ld (hl),d
1315
        ret
1316
 
1317
cmd_let_str
1318
        call eat ;skip '$' and spaces
1319
        exx
1320
        ld a,(hl)
1321
        exx
1322
        cp '('
1323
        jr z,cmd_let_strarray
1324
        ld a,c
1325
        call findvar_str
1326
        jr nz,cmd_let_str_createq
1327
        ld a,c
1328
        call addvar_str
1329
cmd_let_str_createq
344 alone 1330
;hl'=
8 dimkam 1331
        call eateq
1332
        exx
1333
        ld a,(hl)
1334
        exx
1335
        cp '"'
91 demige 1336
        jp nz,fail_syntax
8 dimkam 1337
 
1338
        call readstr ;hl=str, hl'=after num and spaces, CY=error
91 demige 1339
        jp c,fail_syntax
8 dimkam 1340
 
1341
        ;ld hl,wordbuf
1342
        ;STRPUSH
1343
 
1344
        ;ld hl,wordbuf
1345
        ld a,c
1346
        call setvar_str
1347
 
1348
        ;ld hl,wordbuf
1349
        ;STRPOP
1350
 
1351
        ret
1352
 
1353
cmd_let_strarray
1354
        call eat ;skip '(' and spaces
1355
        push bc
1518 alone 1356
        call getexpr_dehl ;dehl=index
8 dimkam 1357
        pop bc
1358
        call eatclosebracket
1359
        call eateq
1518 alone 1360
       ex de,hl
8 dimkam 1361
        ld a,c
1518 alone 1362
        call findvar_str ;hl=str
91 demige 1363
        jp z,fail_syntax
1518 alone 1364
        ld a,d ;de=index
8 dimkam 1365
        or a
91 demige 1366
        jp nz,fail_syntax ;range check
8 dimkam 1367
        add hl,de
1368
        push hl ;addr in str
1518 alone 1369
        call getexpr_dehl ;dehl=char
1370
        ld a,l
8 dimkam 1371
        pop hl ;addr in str       
1518 alone 1372
        ld (hl),a
8 dimkam 1373
        ret
1374
 
1375
cmd_cls
1376
        exx
1377
        push hl
1378
        ld e,0;COLOR
1379
        OS_CLS
1380
        pop hl
1381
        exx
1382
        ret
1383
 
1384
cmd_if
344 alone 1385
;hl'=
1518 alone 1386
        call getexpr_dehl
8 dimkam 1387
        ld a,h
1388
        or l
1389
        or d
1390
        or e
1391
        ret nz ;true = continue this line
1392
gotonextline
1393
        exx
1394
        xor a
1395
        ld bc,0
1396
        cpir
344 alone 1397
        dec hl ; ନ  
8 dimkam 1398
        ld a,(runmode)
1399
        cp RUNMODE_PROG
1400
        jr nz,gotonextlineq
344 alone 1401
        inc hl ;᫥ ப
8 dimkam 1402
        call startline
1403
gotonextlineq
1404
        exx
1405
        ret
1406
 
1407
cmd_goto
344 alone 1408
;hl'=
1518 alone 1409
        call getexpr_dehl
1410
        ex de,hl
1411
;cmd_goto_ok
1412
;de= ப
1413
        call findline ;de 
8 dimkam 1414
        call startline
1415
        exx
1416
        ld a,RUNMODE_PROG
1417
        ld (runmode),a
1418
        ret
1419
 
1420
 
1421
cmd_run
344 alone 1422
; 室  ret, ⮬  run  맢  ࠡ稪  ப
8 dimkam 1423
        ld a,RUNMODE_PROG
1424
        ld (runmode),a
1425
        ld hl,progmem
1426
        jr cmd_run_startline
1427
cmd_run0
344 alone 1428
;hl'= ப
8 dimkam 1429
        exx
1430
        ld a,(hl)
1431
        or a
1432
        jr nz,cmd_run_nonextline
1433
runmode=$+1
1434
        ld a,0
1435
        cp RUNMODE_INTERACTIVE
1436
        jp z,endofprog ;ret z ;end of line in interactive mode
1437
        inc hl
1438
cmd_run_startline
1439
        call startline
1440
cmd_run_nonextline
1441
        exx
1442
        call docmd
1443
        jr cmd_run0
1444
 
1445
startline
1446
        ld bc,(progend)
1447
        or a
1448
        sbc hl,bc
1449
        add hl,bc
1450
        jp nc,endofprog ;ret nc ;end of program
1451
        ;ld d,(hl)
1452
        inc hl
1453
        ;ld e,(hl)
1454
        inc hl
1455
        ;ld (currunline),de
1456
        ;ld e,(hl)
1457
        inc hl
1458
        ;ld d,(hl) ;line size
1459
        inc hl
1460
        ret
1461
 
1462
eatcolon
1463
;out: z=end of command
1464
        exx
1465
        ld a,(hl)
1466
        exx
1467
        or a
1468
        ret z
1469
        cp ':'
1470
        ret nz
1471
        call eat
1472
        xor a ;Z
1473
        ret
1474
 
1475
cmd_print
344 alone 1476
;hl'=
8 dimkam 1477
        call eatcolon
1478
        jp z,prcrlf
9 dimkam 1479
cmd_print0
8 dimkam 1480
        exx
1481
        ld a,(hl)
1482
        exx
1483
        cp ';'
1484
        jp z,cmd_print_semicolon
1518 alone 1485
        call getexpr_dehl
1486
        call prval_dehl
8 dimkam 1487
        jr cmd_print
1488
cmd_print_semicolon
1489
        call eat
1490
        call eatcolon
9 dimkam 1491
        jr nz,cmd_print ;TODO cmd_print0?
8 dimkam 1492
        ret
1493
 
1518 alone 1494
getexpr_dehl
1495
;out: dehl=value, c=type
8 dimkam 1496
        call getaddexpr
91 demige 1497
getexpr0
8 dimkam 1498
        exx
1499
        ld a,(hl)
1500
        exx
1501
        ;cp ','
1502
        ;ret z ;jp z,eat
1503
        ;cp ')'
1504
        ;ret z ;jp z,eat
1505
        ;cp ':' ;call eatcolon
1506
        ;ret z
1507
        ;or a
1508
        ;ret z
1509
        cp '='
1510
        jr z,getexpr_eq
1511
        cp '>'
1512
        jr z,getexpr_more
1513
        cp '<'
1514
        jr z,getexpr_less
1515
        ret
1516
 
1517
getexpr_eq
1518
        call eat
1519
        call getexpr_eq_subr
1520
        jr getexpr0
1521
 
1522
getexpr_more
1523
        call eat
1524
        exx
1525
        ld a,(hl)
1526
        exx
1527
        cp '='
1528
        jr z,getexpr_moreeq
1529
        call getexpr_more_subr
1530
        jr getexpr0
1531
 
1532
getexpr_less
1533
        call eat
1534
        exx
1535
        ld a,(hl)
1536
        exx
1537
        cp '='
1538
        jr z,getexpr_lesseq
1539
        cp '>'
1540
        jr z,getexpr_noteq
1541
        call getexpr_less_subr
1542
        jr getexpr0
1543
 
1544
getexpr_noteq
1545
        call eat
1546
        call getexpr_eq_subr
1547
        call loginv
1548
        jr getexpr0
1549
 
1550
getexpr_moreeq
1551
        call eat
1552
        call getexpr_less_subr
1553
        call loginv
1554
        jr getexpr0
1555
 
1556
getexpr_lesseq
1557
        call eat
1558
        call getexpr_more_subr
1559
        call loginv
1560
        jr getexpr0
1561
 
1562
getexpr_more_subr        
1563
;old > new: new-old = CY
1564
        push bc
1518 alone 1565
        push de ;HSW
1566
        push hl ;LSW
8 dimkam 1567
        call getaddexpr
1568
        pop bc ;LSW
1569
        or a
1570
        sbc hl,bc
1518 alone 1571
        pop bc ;HSW
8 dimkam 1572
        ex de,hl
1573
        sbc hl,bc
1518 alone 1574
        ex de,hl
8 dimkam 1575
        pop bc
1576
        ld hl,0
1577
        ld de,0
1578
        ret nc
1579
        dec hl
1580
        dec de ;old > new
1581
        ret
1582
 
1583
getexpr_less_subr
1584
;old < new: old-new = CY
1585
        push bc
1518 alone 1586
        push de ;old HSW
1587
        push hl ;old LSW
8 dimkam 1588
        call getaddexpr
1589
        pop bc ;old LSW
1590
        pop af ;old HSW
1518 alone 1591
        push de ;new HSW
1592
        push hl ;new LSW
8 dimkam 1593
        push af ;old HSW
1594
        push bc ;old LSW
1518 alone 1595
        pop hl ;old LSW
1596
        pop de ;old HSW
8 dimkam 1597
 
1598
        pop bc ;LSW
1599
        or a
1600
        sbc hl,bc
1518 alone 1601
        pop bc ;HSW
8 dimkam 1602
        ex de,hl
1603
        sbc hl,bc
1518 alone 1604
        ex de,hl
8 dimkam 1605
        pop bc
1606
        ld hl,0
1607
        ld de,0
1608
        ret nc
1609
        dec hl
1610
        dec de ;old < new
1611
        ret
1612
 
1613
getexpr_eq_subr
1614
        push bc
1518 alone 1615
        push de ;HSW
1616
        push hl ;LSW
8 dimkam 1617
        call getaddexpr
1618
        pop bc ;LSW
1619
        or a
1620
        sbc hl,bc
1518 alone 1621
        pop bc ;HSW
8 dimkam 1622
        ex de,hl
1623
        sbc hl,bc
1518 alone 1624
        ex de,hl
8 dimkam 1625
        ld a,d
1626
        or e
1627
        or h
1628
        or l
1629
        pop bc
1630
        ld hl,0
1631
        ld de,0
1632
        ret nz
1633
        dec hl
1634
        dec de ;old = new
1635
        ret
1636
 
1637
getaddexpr
1638
        call getmulexpr
91 demige 1639
getaddexpr0
8 dimkam 1640
        exx
1641
        ld a,(hl)
1642
        exx
1643
        ;or a
1644
        ;ret z
1645
        ;cp ')'
1646
        ;ret z ;jp z,eat
1647
        ;cp ','
1648
        ;ret z ;jp z,eat
1649
        ;cp ':' ;call eatcolon
1650
        ;ret z
1651
        cp '+'
1652
        jr z,getaddexpr_plus
1653
        cp '-'
1654
        jr z,getaddexpr_minus
1655
        ret
1656
 
1657
getaddexpr_plus
1658
        call eat
1659
        push bc
1518 alone 1660
        push de ;HSW
1661
        push hl ;LSW
8 dimkam 1662
        call getmulexpr
1663
        pop bc ;LSW
1664
        add hl,bc
1518 alone 1665
        pop bc ;HSW
8 dimkam 1666
        ex de,hl
1667
        adc hl,bc
1518 alone 1668
        ex de,hl
8 dimkam 1669
        pop bc
1670
        jr getaddexpr0
1671
 
1672
getaddexpr_minus
1673
        call eat
1674
        push bc
1518 alone 1675
        push de ;HSW
1676
        push hl ;LSW
8 dimkam 1677
        call getmulexpr
1678
        pop bc ;LSW
1679
        or a
1680
        sbc hl,bc
1518 alone 1681
        pop bc ;HSW
8 dimkam 1682
        ex de,hl
1683
        sbc hl,bc
1518 alone 1684
        ex de,hl
1685
        call negdehl
8 dimkam 1686
        pop bc
1687
        jr getaddexpr0
1688
 
1689
getmulexpr
1518 alone 1690
        call getval_dehl_
91 demige 1691
getmulexpr0
8 dimkam 1692
        exx
1693
        ld a,(hl)
1694
        exx
1695
        ;or a
1696
        ;ret z
1697
        ;cp ')'
1698
        ;ret z ;jp z,eat
1699
        ;cp ','
1700
        ;ret z ;jp z,eat
1701
        ;cp ':' ;call eatcolon
1702
        ;ret z
1703
        cp '*'
1704
        jr z,getmulexpr_mul
1705
        cp '/'
1706
        jr z,getmulexpr_div
1707
        ret
1708
 
1709
getmulexpr_div
1710
        call eat
1711
        push bc
1518 alone 1712
        push de ;HSW old
1713
        push hl ;LSW old
1714
        call getval_dehl_
1715
        push de ;HSW new
8 dimkam 1716
        push hl ;LSW new
1717
        exx
1718
        pop ix ;LSW new
1719
        pop bc ;HSW new
1720
        pop de ;LSW old
1721
        ex (sp),hl ;pop hl ;HSW old
1518 alone 1722
        call _DIVLONG. ;hl, de / bc, ix ;out: hl(high), de(low)
1723
       ex de,hl ;dehl
8 dimkam 1724
        exx
344 alone 1725
        pop hl ;
8 dimkam 1726
        exx
1727
        pop bc
1728
        jr getmulexpr0
1729
 
1730
getmulexpr_mul
1731
        call eat
1732
        push bc
1518 alone 1733
        push de ;HSW
1734
        push hl ;LSW
1735
        call getval_dehl_
8 dimkam 1736
        pop ix ;LSW
1737
        pop bc ;HSW
1518 alone 1738
       ex de,hl ;hl,de
8 dimkam 1739
        call _MULLONG.
1518 alone 1740
       ex de,hl ;dehl
8 dimkam 1741
        pop bc
1742
        jr getmulexpr0
1743
 
1744
;hl, de / bc, ix
1745
;out: hl(high), de(low)
1746
_DIVLONG.
1747
        ;EXPORT _DIVLONG.
1748
        ld a,h
1749
        xor b
1750
        push af
1751
        xor b
1518 alone 1752
        call m,div_neghlde
8 dimkam 1753
        ld a,b
1754
        rla
1755
        jr nc,divlongnonegbcix
1756
        xor a
1757
        sub lx
1758
        ld lx,a
1759
        ld a,0
1760
        sbc a,hx
1761
        ld hx,a
1762
        ld a,0
1763
        sbc a,c
1764
        ld c,a
1765
        ld a,0
1766
        sbc a,b
1767
        ld b,a
1768
divlongnonegbcix
1769
;unsigned!!!
1770
;hl'hl,de'de <= hlde,bcix:
1771
        push bc
1772
        exx
1773
        pop de ;de' = "bc_in"
1774
        ld hl,0
1775
        exx
1776
        ld a,e
1518 alone 1777
        ex af,af' ;' ;e_in
8 dimkam 1778
        push de ;d_in
1779
        ld c,l ;l_in
1780
        ld a,h ;h_in
1781
        ld hl,0
1782
        push ix
1783
        pop de ;de = "ix_in"
1784
        ;a="h_in"
1785
;hl'hla <= 0000h_in
1786
        call _DIVLONGP. ;"h"
1787
        ld b,c ;"l_in"
1788
        ld c,a ;"h"
1789
        ld a,b ;a="l_in"
1790
;hl'hla <= 000hl_in
1791
        call _DIVLONGP. ;"l"
1792
        ld b,a ;"l"
1793
        pop af ;a="d_in"
1794
        push bc ;b="l"
1795
;hl'hla <= 00hld_in
1796
        call _DIVLONGP. ;"d"
1797
        ex af,af' ;a="e_in", a'="d"
1798
        ;a="e_in"
1799
;hl'hla <= 0hlde_in
1800
        call _DIVLONGP. ;"e"
1801
        ld e,a ;"e"
1518 alone 1802
        ex af,af' ;' ;"d"
8 dimkam 1803
        ld d,a
1804
        pop hl ;h="l"
1805
        ld l,h
1806
        ld h,c ;"h"
1807
 
1808
        pop af
1809
        ret p
1518 alone 1810
div_neghlde
1811
        xor a
1812
        sub e
1813
        ld e,a
1814
        ld a,0
1815
        sbc a,d
1816
        ld d,a
1817
        ld a,0
1818
        sbc a,l
1819
        ld l,a
1820
        ld a,0
1821
        sbc a,h
1822
        ld h,a
1823
        ret
1824
 
8 dimkam 1825
;a = hl'hla/de'de
1826
;c not used
1827
_DIVLONGP.
1828
;do 8 bits
1829
        ld b,8
1830
_DIVLONG0.
1831
;shift left hl'hla
1832
        rla
1833
        adc hl,hl
1834
        exx
1835
        adc hl,hl
1836
        exx
1837
;no carry
1838
;try sub
1839
        sbc hl,de
1840
        exx
1841
        sbc hl,de
1842
        exx
1843
        jr nc,$+2+1+1+2+1
1844
        add hl,de
1845
        exx
1846
        adc hl,de
1847
        exx
1848
;carry = inverted bit of result
1849
        djnz _DIVLONG0.
1850
        rla
1851
        cpl
1852
        ret
1853
 
1854
;hl, de * bc, ix
1855
;out: hl(high), de(low)
1856
_MULLONG.
1857
        ;EXPORT _MULLONG.
1858
;signed mul is equal to unsigned mul
1859
;hlde*bcix = hlde*b000 + hlde*c00 + hlde*i0 + hlde*x
1860
        ld a,lx
1861
        push af ;lx
1862
        push ix ;hx
1863
        ld a,c
1864
        push af ;c
1865
        ld a,b
1866
;bcde <= hlde:
1867
        ld b,h
1868
        ld c,l
1869
;hlix <= 0
1870
        ld hl,0
1871
        ;ld ix,0
1872
        push hl
1873
        pop ix
1874
        call _MULLONGP. ;hlix = (hlix<<8) + "b*hlde"
1875
        pop af ;c
1876
        call _MULLONGP. ;hlix = (hlix<<8) + "c*hlde"
1877
        pop af ;hx
1878
        call _MULLONGP. ;hlix = (hlix<<8) + "hx*hlde"
1879
        pop af ;lx
1880
        call _MULLONGP. ;hlix = (hlix<<8) + "lx*hlde"
1881
        push ix
1882
        pop de
1883
        ret
1884
;hlix = (hlix<<8) + a*bcde
1885
_MULLONGP.
1886
        exx
1887
        ld b,8
1888
_MULLONG0.
1889
        exx
1890
        add ix,ix
1891
        adc hl,hl
1892
        rla
1893
        jr nc,$+2+2+2
1894
        add ix,de
1895
        adc hl,bc
1896
        exx
344 alone 1897
        djnz _MULLONG0. ;  a==0 ( 室  scf:rla,  add a,a)
8 dimkam 1898
        exx
1899
        ret
1900
 
1901
 
1902
 
1903
getval_unaryminus
1904
        call eat
1518 alone 1905
        call getval_dehl_
1906
        jp negdehl
8 dimkam 1907
getval_bracket
1908
        call eat
1518 alone 1909
        call getexpr_dehl
8 dimkam 1910
        jp eatclosebracket
1911
 
1518 alone 1912
getval_dehl_
344 alone 1913
;hl'=
1518 alone 1914
;out: dehl=value, c=type
8 dimkam 1915
        exx
1916
        ld a,(hl)
1917
        exx
1918
        cp '$'
1919
        jp z,getval_function
1920
        cp '-'
1921
        jr z,getval_unaryminus
1922
        cp '('
1923
        jr z,getval_bracket
1924
        cp '"'
1518 alone 1925
        jp z,getval_str
8 dimkam 1926
        sub '0'
1927
        cp 10
1518 alone 1928
        jr c,getval_num_dehl
8 dimkam 1929
        exx
1930
        ld a,(hl)
1931
        exx
9 dimkam 1932
        ld c,a ;name
8 dimkam 1933
        exx
1934
        inc hl ;call eat
1935
        ld a,(hl)
1936
        exx
1937
        cp '$'
1938
        jr z,getval_varstr
1939
        cp '('
1940
        jr z,getval_vararray
1941
        call eatspaces
1942
        ld a,c
1943
        call findvar_int
91 demige 1944
        jp z,fail_syntax
8 dimkam 1945
        ;ld a,c
1946
        ;call getvar_int
1947
        call getint
1948
        res 7,c ;ld c,0 ;int
1949
        ret
1950
getval_varstr
1951
        call eat ;skip '$' and spaces
1952
        exx
1953
        ld a,(hl)
1954
        exx
1955
        cp '('
1956
        jr z,getval_varchararray        
1957
        ld a,c
1958
        call findvar_str
91 demige 1959
        jp z,fail_syntax
8 dimkam 1960
        ;ld a,c
1961
        ;call getvar_str
1962
        set 7,c ;ld c,128 ;str
1963
        ret
1964
getval_varchararray
1965
        call eat
1966
        push bc
1518 alone 1967
        call getexpr_dehl
8 dimkam 1968
        pop bc
1969
        call eatclosebracket
1518 alone 1970
       ex de,hl ;de=index
8 dimkam 1971
        ld a,c
1972
        call findvar_str
91 demige 1973
        jp z,fail_syntax
1518 alone 1974
        ld a,d ;de=index
8 dimkam 1975
        or a
91 demige 1976
        jp nz,fail_syntax ;range check
8 dimkam 1977
        add hl,de
1518 alone 1978
        ld l,(hl)
1979
        ld de,0
1980
        ld h,d ;dehl=char
8 dimkam 1981
        res 7,c ;ld c,0 ;int
1982
        ret
1983
getval_vararray
1984
        call eat
1985
        push bc
1518 alone 1986
        call getexpr_dehl
8 dimkam 1987
        pop bc
1988
        call eatclosebracket
1518 alone 1989
       ex de,hl ;de=index
8 dimkam 1990
        ld a,c
1991
        call findvar_array
91 demige 1992
        jp z,fail_syntax
8 dimkam 1993
        call indexarray
1994
        call getint
1995
        res 7,c ;ld c,0 ;int
1996
        ret
1518 alone 1997
getval_num_dehl
1998
        call readnum_dehl ;dehl=num, hl'=after num and spaces, CY=error
91 demige 1999
        jp c,fail_syntax
8 dimkam 2000
        res 7,c ;ld c,0 ;int
2001
        ret
2002
getval_str
2003
        call readstr ;hl=str, hl'=after str and spaces, CY=error
91 demige 2004
        jp c,fail_syntax
8 dimkam 2005
        set 7,c ;ld c,0 ;str
2006
        ret
2007
 
1518 alone 2008
prval_dehl
2009
;dehl=value, c=type
8 dimkam 2010
        exx
2011
        push hl
2012
        exx
2013
        bit 7,c
2014
        jr nz,prval_str
1518 alone 2015
        call prdword_dehl
8 dimkam 2016
        pop hl
2017
        exx
2018
        ret
2019
prval_str
2020
        call prstr_withlen
2021
        pop hl
2022
        exx
2023
        ret
2024
 
2025
 
2026
readstr
344 alone 2027
;hl'= (㪠뢠  뢠 )
8 dimkam 2028
;out: hl=str, hl'=after num and spaces, CY=error
2029
        exx
2030
        inc hl
2031
        ld de,wordbuf
344 alone 2032
;TODO ஢ઠ 
8 dimkam 2033
quote_getword0
2034
        ld a,(hl)
2035
        or a
2036
        ccf
2037
        ret z ;CY=error
2038
        ;jp z,fail ;jr z,quote_getwordq
2039
        sub '"'
2040
        jr z,quote_getwordq
2041
        ldi
2042
        jp quote_getword0
2043
quote_getwordq
2044
        xor a
2045
        ld (de),a
2046
        exx
344 alone 2047
        call eat ;ꥤ   ᫥騥 ஡
8 dimkam 2048
        ld hl,wordbuf
2049
        or a ;NC = OK
2050
        ret ;NC
2051
 
2052
indexarray
344 alone 2053
;hl= ᨢ
2054
;de=
2055
;c= ᨢ?
2056
;out: hl=  (fail, ᫨ out of bounds)
8 dimkam 2057
        push bc
2058
        ld c,(hl)
2059
        inc hl
2060
        ld b,(hl)
2061
        inc hl
2062
        ex de,hl
2063
        or a
2064
        sbc hl,bc
2065
        add hl,bc
2066
        ex de,hl
2067
        pop bc
91 demige 2068
        jp nc,fail_syntax ;range check
8 dimkam 2069
        add hl,de
2070
        add hl,de
2071
        add hl,de
2072
        add hl,de
2073
        ret
2074
 
2075
func_rnd
2076
;Patrik Rak
2077
rndseed1=$+1
2078
        ld  hl,0xA280   ; xz -> yw
2079
rndseed2=$+1
2080
        ld  de,0xC0DE   ; yw -> zt
2081
        ld  (rndseed1),de  ; x = y, z = w
2082
        ld  a,e         ; w = w ^ ( w << 3 )
2083
        add a,a
2084
        add a,a
2085
        add a,a
2086
        xor e
2087
        ld  e,a
2088
        ld  a,h         ; t = x ^ (x << 1)
2089
        add a,a
2090
        xor h
2091
        ld  d,a
2092
        rra             ; t = t ^ (t >> 1) ^ w
2093
        xor d
2094
        xor e
2095
        ld  h,l         ; y = z
2096
        ld  l,a         ; w = t
2097
        ld  (rndseed2),hl
2098
        ex de,hl
2099
        ld hl,0
2100
        res 7,c ;int
2101
        ret