function token_init(ptr_token_info) implicit none c c Init the token list c include 'token.inc' integer*4 ptr_token_info !:o: pointer to token block integer*4 token_init !:f: function result c integer*4 lib$get_vm integer*4 lib$create_vm_zone c record /token_info/ token_info pointer (p_token_info,token_info) c integer*4 istat c istat = lib$get_vm(sizeof(token_info),p_token_info) if(.not. istat) goto 90 c istat = lib$create_vm_zone(token_info.zone_id) if(.not. istat) goto 90 c token_info.ptr_first = 0 token_info.n_token = 0 ptr_token_info = p_token_info c 90 token_init = istat c return end function token_exit(ptr_token_info) implicit none c include 'token.inc' integer*4 ptr_token_info integer*4 token_exit c integer*4 istat c record /token_info/ token_info pointer (p_token_info,token_info) c integer*4 lib$delete_vm_zone integer*4 lib$free_vm c p_token_info = ptr_token_info c istat = lib$delete_vm_zone(token_info.zone_id) if(.not. istat) goto 90 c token_info.zone_id = 0 token_info.ptr_first = 0 token_info.n_token = 0 c istat = lib$free_vm(sizeof(token_info),token_info) c 90 token_exit = istat return end function token_add(ptr_token_info,name,ptr_terminal_info,negated, 1 ptr_command) implicit none c c Add a new token (belonging to a specific command/syntax) to the list c include 'token.inc' integer*4 ptr_token_info !:i: pointer to token control block character*(*) name !:i: the name logical negated !:i: was it negated integer*4 ptr_terminal_info !:i: terminal block integer*4 ptr_command !:i: parent command block integer*4 token_add !:f: function result c# record /token/ token pointer (p_token,token) c integer*4 k,istat,p_cur,pos,bpos integer*4 lib$get_vm c record /token_info/ token_info pointer (p_token_info,token_info) c p_token_info = ptr_token_info c call terminal_debug(ptr_terminal_info,'Added token '//name,0, 1 dbg_flag_tok) c c c Find the position of the part after the last . c istat = 1 c bpos = 0 10 pos = index(name(bpos+1:),'.') if(pos .gt. 0) then bpos = pos + bpos goto 10 endif c p_token = token_info.ptr_first do while(p_token .ne. 0) k = p_token c c See if it is the same, if so just replace the negated part c if(token.name(1:token.nk_name) .eq. name .and. 1 token.ptr_command .eq. ptr_command) goto 50 p_token = token.ptr_next end do c c We had no match, so we need to add a new one c Now k contains the pointer to the last token c or 0 if no tokens defined c istat = lib$get_vm(sizeof(token),p_token,token_info.zone_id) if(.not. istat) goto 90 c token.nk_name = len(name) !length of the name token.name = name !the name token.idx_last = bpos + 1 !offset to part after the . token.ptr_command = ptr_command !pointer to command block token.ptr_next = 0 !no next yet c c c Now link into the chain c if(k .eq. 0) then token_info.ptr_first = p_token else c c Now k points to the previous record c p_cur = p_token p_token = k token.ptr_next = p_cur endif c c 50 token.negated = negated 90 token_add = istat return end function token_lookup(ptr_token_info,name,negated,ptr_command) implicit none c c See if name is in the token list c include 'token.inc' integer*4 ptr_token_info !:i: pointer to pointer control block character*(*) name !:i: the name searched for logical*4 negated !:i: was is negated? integer*4 ptr_command !:i: belonging to this command logical token_lookup !:f: functiont result c integer*4 bpos c record /token/ token pointer (p_token,token) c record /token_info/ token_info pointer (p_token_info,token_info) c p_token_info = ptr_token_info c token_lookup = .true. c p_token = token_info.ptr_first do while(p_token .ne. 0) if(token.ptr_command .eq. ptr_command) then bpos = token.nk_name - len(name) + 1 if(bpos .gt. 0 .and. bpos .le. token.idx_last) then if(token.name(bpos:token.nk_name) .eq. name) then negated = token.negated goto 90 endif endif c endif p_token = token.ptr_next end do token_lookup = .false. 90 return end function token_remove(ptr_token_info,name,ptr_terminal_info, 1 ptr_command) implicit none c c See if name is in the token list, and them remove it c include 'token.inc' integer*4 ptr_token_info !:i: pointer to pointer control block integer*4 ptr_terminal_info !:i: terminal block character*(*) name !:i: the name searched for integer*4 ptr_command !:i: belonging to this command logical token_remove !:f: functiont result c integer*4 bpos,prev_ptr,k,l,istat c record /token/ token pointer (p_token,token) c external auto_msg_interr c record /token_info/ token_info pointer (p_token_info,token_info) c p_token_info = ptr_token_info c c call terminal_debug(ptr_terminal_info,'Deleted token '//name,0, 1 dbg_flag_tok) c prev_ptr = 0 p_token = token_info.ptr_first do while(p_token .ne. 0) if(token.ptr_command .eq. ptr_command) then bpos = token.nk_name - len(name) + 1 if(bpos .gt. 0 .and. bpos .le. token.idx_last) then if(token.name(bpos:token.nk_name) .eq. name) then c c Now link out this one c l = p_token !remeber me k = token.ptr_next !remember the next if(prev_ptr .eq. 0) then token_info.ptr_first = k else p_token = prev_ptr !point to the previous token.ptr_next = k endif c p_token = l !point to me again c c And insert it in the free list c token.ptr_next = token_info.deleted_list ! token_info.deleted_list = p_token istat = 1 goto 90 endif endif c endif prev_ptr = p_token p_token = token.ptr_next end do istat = %loc(auto_msg_interr) 90 token_remove = istat return end