view TL1/test/t4.tl1 @ 177:3770e86114aa

TL/1 fix
author Shinji KONO <kono@ie.u-ryukyu.ac.jp>
date Mon, 15 Apr 2019 04:27:18 +0900
parents 6ef317714ae8
children 4d83154d2a78
line wrap: on
line source

% ** TEST PROGRAM **
FUNC SEARCH
%--- MAIN ---
VAR DICT,BUF,D
ARRAY TEND[2]
BEGIN
  WRITE(DICT:ASCII(0))
  DICT := OPENM($2,0)
  WRITE(DICT:ASCII(0))
  WRITE(DICT:ASCII(30),ASCII(0-'P'),"ROC")
  WRITE(DICT:ASCII(31),ASCII(0-'F'),"UNC")
  WRITE(DICT:ASCII(33),ASCII(0-'V'),"AR",CRLF)
  D:=POSITION(DICT,TEND)
  BUF := OPENM($2,0)
  WRITE(BUF:"FUNC",ASCII(0))
  WRITE(0:SEARCH(BUF),CRLF)
  D:=SEEK(BUF,0)
  WRITE(BUF:"NONAME",ASCII(0))
  WRITE(0:SEARCH(BUF),CRLF)
END

SEARCH(BUF)
VAR VAL,K,C,D
ARRAY BEND
BEGIN
  VAL := SEEK(DICT,TEND)
  D:=POSITION(BUF,BEND)
  WHILE VAL#0 DO [
     C:=SEEKR(BUF,0-1)
     K:=SEEKR(DICT,0-1)
     IF K.LT.0 THEN [
       IF C=0-K THEN
          RETURN VAL    % FOUND
       VAL := SEEKR(DICT,0-1)
     ] ELSE IF C#K THEN [
       D:=SEEK(BUF,BEND)
       REPEAT
          K:=SEEKR(DICT,0-1)
       UNTIL K.LT.0
       VAL := SEEKR(DICT,0-1)
     ]
  ]
  RETURN VAL % NOT FOUND
END