Mercurial > hg > Members > kono > os9 > sbc09

changeset 175:c83545730d6c

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
openm
author Shinji KONO <kono@ie.u-ryukyu.ac.jp>
date Sun, 14 Apr 2019 17:17:34 +0900
parents ce695e5e38d8
children 6ef317714ae8
files TL1/TL1os9.asm TL1/test/t4.tl1
diffstat 2 files changed, 107 insertions(+), 30 deletions(-) [+]
line wrap: on
line diff
--- a/TL1/TL1os9.asm	Sun Apr 14 11:19:27 2019 +0900
+++ b/TL1/TL1os9.asm	Sun Apr 14 17:17:34 2019 +0900
@@ -155,13 +155,15 @@
        STA CH
 **  copy reserved word table
        LEAX WTABLE,PCR
-       leay WTBLE,u
-       ldb #WTBLEND-WTABLE
+       pshs u
+       leau WTBLE,u
+       ldy #WTBLEND-WTABLE
 tbl1   lda ,x+
-       sta ,y+
-       decb
+       sta ,u+
+       leay -1,y
        bne tbl1
-       sty TEND
+       stu TEND
+       puls u
 ** 
        LBSR CRLF
        BSR REG0
@@ -1110,7 +1112,7 @@
 ** FUNCTION RND
 TM6    CMPA #$70 
        BNE TM61 
-       BSR SUBSC
+       LBSR SUBSC
        LBSR PUTHSL
        FCB $0317
        FDB RND
@@ -1118,7 +1120,7 @@
 * FUNTION GET
 TM61   CMPA #$71
        BNE TM62 
-       BSR SUBSC
+       LBSR SUBSC
        LBSR PUTHS
        FDB $0297
        FCB INDN
@@ -1126,10 +1128,10 @@
        FCB $0317
        FDB getchar
        RTS
-* FUNCTION READ 
+* FUNCTION READ etc
 TM62   CMPA #$72 
-       BNE TM7
-       BSR SUBSC
+       BNE TM63
+       LBSR SUBSC
        LBSR PUTHS
        FDB $0297
        FDB INDN
@@ -1137,6 +1139,42 @@
        FCB $038D
        FDB GETDA
        RTS
+TM63   CMPA #$A2      seek
+       BNE TM64
+       LBSR SUBSC
+       LBSR PUTHSL
+       FCB  $0317
+       FDB  NONE
+       RTS
+TM64   CMPA #$A3      seekr
+       BNE TM65
+       LBSR SUBSC
+       LBSR PUTHSL
+       FCB  $0317
+       FDB  NONE
+       RTS
+TM65   CMPA #$A4      position
+       BNE TM66
+       LBSR SUBSC
+       LBSR PUTHSL
+       FCB  $0317
+       FDB  NONE
+       RTS
+TM66   CMPA #$A5      open
+       BNE TM67
+       LBSR SUBSC
+       LBSR PUTHSL
+       FCB  $0317
+       FDB  NONE
+       RTS
+TM67   CMPA #$A6      openm
+       BNE TM7
+       LBSR SUBSC
+       LBSR PUTHSL
+       FCB  $0317
+       FDB  NONE
+       RTS
+
 * FUNCTION NOTASL ET AL
 TM7    CMPA #$40
        BCS TM8
@@ -1168,21 +1206,21 @@
        LBSR PUTABX
        LBRA LDAAX
 **
-DSUBSC LDA #$3C
+DSUBSC LDA #$3C    ','
        BSR SUBS1
-       LDA #$3B
+       LDA #$3B    ')'
        PSHS A
        BRA SUBS2
 SUBSC  LDA #$3E
 SUBS1  PSHS A
        LBSR WORD
-       LDA #$37
+       LDA #$37    '('
        LBSR CHECK
 SUBS2  LBSR EXPR
        PULS A 
        LBRA CHECK
 SUBSC1 LBSR WORD
-       LDA #$36
+       LDA #$36     '['
        LBSR CHECK
        LBSR LEXPR
        LDB LSW
@@ -1190,7 +1228,7 @@
        LDB AMODE
        BEQ SBS5
        LBSR OLOAD
-SBS5   LDA #$3A
+SBS5   LDA #$3A     ']'
        LBRA CHECK
 * MEM FUNCTION
 TM9    CMPA #6
@@ -1622,6 +1660,16 @@
        FCB $71,-'G','E','T'
        FCB $72,-'R'
        FCC "EAD"
+       FCB $A2,-'S'
+       FCC "SEEK"
+       FCB $A3,-'S'
+       FCC "SEEKR"
+       FCB $A4,-'P'
+       FCC "OSITION"
+       FCB $A5,-'O'
+       FCC "PEN"
+       FCB $A6,-'O'
+       FCC "PENM"
 WTBLEND 
 
 ******
@@ -1632,21 +1680,6 @@
 crt0top
 
 **
-* PUSH LB & SET NEW LB
-**
-*PSHLB  pshs y
-*       leay ,x
-*       leax a,x
-*       sty ,x++
-*       puls y,pc
-**
-* PULL LB
-**
-*  
-*PULLB  LDX ,--X
-*       TSTA
-*       RTS
-**
 * RND FUNCTION
 **
 RND    PSHS A
@@ -1664,6 +1697,7 @@
        PULS B
        MUL
        INCA
+NONE
        RTS
 **
 * DVISITION SET MOD 
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/TL1/test/t4.tl1	Sun Apr 14 17:17:34 2019 +0900
@@ -0,0 +1,43 @@
+% ** TEST PROGRAM **
+func search
+%--- main ---
+var dict,buf
+array tend[2]
+begin
+  dict := openm($2,0)
+  write(dict:ascii(0))
+  write(dict:ascii(30),ascii(-'P'),"ROC")
+  write(dict:ascii(31),ascii(-'F'),"UNC")
+  write(dict:ascii(33),ascii(-'V'),"AR")
+  postion(dict,tend)
+  buf := openm($2,0)
+  write(buf:"FUNC",ascii(0))
+  write(0:search(buf),crlf)
+  seek(buf,0)
+  write(buf:"NONAME",ascii(0))
+  write(0:search(buf),crlf)
+end
+
+search(buf)
+var val,k,c
+array bend
+begin
+  val := seek(dict,tend)
+  position(buf,bend)
+  while val#0 do [
+     c:=seekr(buf,-1)
+     k:=seekr(dict,-1)
+     if k.lt.0 then [
+       if c=-k then
+          return val    % found
+       val := seekr(dict,-1)
+     ] else if c#k then [
+       seek(buf,bend)
+       repeat
+          k:=seekr(dict,-1)
+       until k.lt.0
+       val := seekr(dict,-1)
+     ]
+  ]
+  return val % not found
+end