Trailing-Edge
-
PDP-10 Archives
-
decuslib20-03
-
decus/20-0078/libsim/tagord.mac
There are 2 other files named tagord.mac in the archive. Click here to see a list.
COMMENT * SIMULA specification;
OPTIONS(/E:QUICK,tagord);
TEXT PROCEDURE tagord(tt); NAME tt; TEXT tt;
COMMENT Skips any blanks or tabs, starting at tt.Pos. If tt.More holds then, an item
is identified according to the following rules:
a) If the first following character is a letter (a-z,},{,`,A-Z,$,#,@), an identifier is found.
The identifier consists of the initial letter and any following letters and/or
decimal digits or '_' (underline).
b) If the first character is a digit, we have a numeric item, consisting of a
string of digits with at most one decimal point "." included.
c) Any other character except blank or tab forms an item on its own.
Example: "IF car.wheel_size > 13.5" will be split into the items
"IF", "car", ".", "wheel_size", ">", "13.5"
via successive calls to TAGORD.
The value of TAGORD is a subtext reference to the item within tt, or NOTEXT if
no item can be found starting at tt.Pos. tt.Pos will be placed after the item.
;
!*;! MACRO-10 code !*;!
TITLE tagord
ENTRY tagord
SUBTTL SIMULA utility, Lars Enderin Mar 1977
;!*** Copyright 1977 by the Swedish Defence Research Institute. ***
;!*** Copying is allowed. ***
sall
search simmac,simmcr,simrpa
macinit
;! Local definitions ;!
tt==XWAC1 ;! ZFL for parameter
t1==XWAC2 ;! byte pointer
t== XWAC1 ;! Address of descriptor for tt
sp==XWAC4 ;! starting position of item
tagord:
PROC
EXCH XWAC1,(XTAC) ;! Normalize ac contents
EXCH XWAC2,1(XTAC)
SAVE <XTAC,XWAC3,XWAC4>
ADDI t1,(tt) ;! Address of ZTV for tt
L t,t1 ;! t:-tt
LF ,ZTVSP(t)
LF X1,ZTVCP(t)
LF sp,ZTVLNG(t)
ADDI 2*5(X1) ;! Offset to first byte of rest(tt)
IDIVI 5
LF t1,ZTVZTE(t)
ADDM t1 ;! Word address of first byte
HLL t1,ptab(X1) ;! Byte pointer to it
LF X1,ZTVLNG(t)
LF ,ZTVCP(t)
SUB X1, ;! rest(t).Length
JUMPLE X1,L9 ;! NOTEXT
LOOP ;! Skipping spaces and tabs
ILDB t1 ;! window:=t.Getchar
AOS 1(t)
AS
CAIE " "
CAIN " "
SOJG X1,TRUE
SA
JUMPLE X1,L9 ;! NOTEXT
LF sp,ZTVCP(t) ;! Start pos of item
SUBI sp,1
ST X2 ;! Save char
IF ;! Bokstav(window)
CAIGE X2,"#"
GOTO FALSE
CAIG X2,"z"
GOTO L1
CAIE X2,"}"
CAIN X2,"{"
GOTO TRUE
GOTO FALSE
L1():! CAIG "$"
GOTO TRUE
TRZ X2," "
CAIL X2,"@"
CAILE X2,"Z"
GOTO FALSE
THEN ;! Identifier
LOOP
SOJL X1,out
ILDB t1
AOS 1(t)
AS ;! Bokstav(window) OR Digit(window) OR window='_'
CAIGE "#"
GOTO FALSE ;! "#" is lowest possible
CAIG "$" ;! "$" is next
GOTO TRUE
CAIGE "0"
GOTO FALSE
CAIG "9"
GOTO TRUE ;! Digit
CAIGE "@"
GOTO FALSE
CAIG "Z"
GOTO TRUE ;! Upper case Swedish letter
CAIGE "_"
GOTO FALSE
CAIG "z"
GOTO TRUE ;! Lower case or "_"
CAIE "}"
CAIN "{"
GOTO TRUE ;! Remaining lower case
GOTO FALSE
SA
ELSE ;! Numeric or other
IF ;! Digit(window)
CAIL "0"
CAILE "9"
GOTO FALSE
THEN ;! Find more digits, at most one "."
LI X2,1 ;! First time through
L8():! LOOP
SOJL X1,out
ILDB t1
AOS 1(t)
AS ;! Digit(window)
CAIL "0"
CAILE "9"
GOTO FALSE
GOTO TRUE
SA
IF ;! First time we find a non-digit
SOJL X2,FALSE
THEN ;! Accept a "." only
CAIN "."
GOTO L8 ;! To find fraction
FI
ELSE ;! Account for the character
AOS 1(t)
FI FI
LF ,ZTVCP(t) ;! t.Pos-1
CAILE 1(sp)
SOS 1(t)
out: LD XWAC1,(t)
MOVSI X1,(sp)
MOVSI XWAC2,(XWAC2)
SUB XWAC2,X1
ADD XWAC1,X1
SKIPN XWAC2
L9():! SETZB XWAC1,XWAC2
RESTORE
EXCH XWAC2,1(XTAC)
EXCH XWAC1,0(XTAC)
POPJ XPDP,
EPROC
ptab: POINT 7,2,-1
POINT 7,2,6
POINT 7,2,13
POINT 7,2,20
POINT 7,2,27
LIT
END;