|
DataMuseum.dkPresents historical artifacts from the history of: Philips Data Systems |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Philips Data Systems Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 49416 (0xc108)
Notes: pts_type(SC)
Names: »SYNVAL.SC«
└─⟦f45ea3bc3⟧ Bits:30009713 Philips computer tape "WSM"
└─⟦this⟧ »WSM:CREA/SYNVAL.SC«
IDENT SYNVAL REL=2.3,850606,870155940230
*************************************************************
*
* LATEST UPDATE 850606 MADE BY:JE
*
* HISTORY=
* 850606/JE CHECK OF OVFL-ENTRIES 'ATTAB' ROUTINE 'VARDET'
* 850509/JE ORDER OF CONTROL CHNGED 'VARDET' BEFORE FUNCTIONS
* 850221/JE FASTER PROCESSING OF EVALUATION OF FID:S
* 850211/CJ IDENTION ERROR FOR FID<LEN4 ,"ON FID GOTO ..."
* 841120/CJ MUL&DIV NOW FROM ASSROUTINE
* 840921/CJ BASIC ERROR WHEN USE OF FID=AB,NU - SOLVED
* 830422/CJ EXTANSION OF ATTRIBUTES "ATTR" SA,CA
*
*************************************************************
DDUM WSMDDV
PDIV
ENTRY SYNVAL ***SYNTAX OF VALIDATION
ENTRY BSVSEA ***BASIC VERB SEARCH
EXPROC ZERFLL,PSTRG,PBIN,PBIN ***ZERO REFILL /00:S
EXT ICLEAR ---CLEAR ITEM
EXT EMPTYT ---CHECK IF EMPTY
EXT GETIND ---GET ITEM LENGTH
EXT WXMUL ---MULTIPLICATION
EXT WXDIV ---DIVISION
EJECT
*
* SYNTAX OF VALIDATION
* 1 - CHECK IF A LINE NUMBER WAS ENTERED
* RANGE IT 0000 < LINE NUMBER < 2047
* 2 - INDENTIONS LEADING BLANKS
* 3 - BASIC VERB
* 4 - X - BASIC VERB DEPENDENT
*
* INPUT : LSTR81 = BASIC LINE
* LBIN1 = NUMBER OF INPUT CHARACTERS
*
* USED : LBIN3
* LBIN4 = BASIC LINE POINTER
* VBIN6
* VBIN7
* VBIN8
* LBIN12
* LBIN17
* LBIN20
*
* OUTPUT: LBIN1 = ERRONEUS POSITION (IF ERROR)
* LBIN4 = SYNTAX ERROR (NUMBER)
* CR = 0 OK
* = 1 NOT OK
*
************************************************************************
SYNVAL PROC
MOVE LBIN4,W0 INPUT BUFFER POINTER:=0
CALL ICLEAR,LSTR4A ---CLEAR ITEM
EJECT
*
* CHECK IF LINE NUMBER WAS ENTERED
*
CLEAR VBOOL1 FALSE=NO LINE NUMBER FOUND
MOVE LBIN3,W4 LOAD MAXLENGTH OF LINE NUMBER
CBG LBIN1,W4,SYN040 JMP IF GREATER MAXLENGTH
MOVE LBIN3,LBIN1 LOAD ACTUAL LENGTH < 4
SYN040
XCOPY LSTR1,W0,W1,LSTR81,LBIN4 GET ONE CHARACTER
CBL LSTR1,=X'30',SYN050 JMP IF NOT A DIGIT
CBG LSTR1,=X'39',SYN050 JMP IF NOT A DIGIT
XCOPY LSTR4A,LBIN4,W1,LSTR1,W0 STORE DIGIT
ADD LBIN4,W1 ADJUST LINE NUMBER LENGTH
CBNE LBIN4,LBIN3,SYN040 JMP IF NOT MAXLENGTH
SYN050
CALL EMPTYT,LSTR4A ---CHECK IF EMPTY
BNOK SYN100 JMP IF NO LINE NUMBER
MOVE LINNO(W9),LSTR4A CONVERT TO BCD
MOVE LBIN3,LINNO(W9) CONVERT TO BINARY
CBL LBIN3,W1,SYN060 JMP IF OUT OF RANGE
CBG LBIN3,=X'07FF',SYN060 JMP IF OUT OF RANGE
SET VBOOL1 TRUE=LINE NUMBER FOUND
B SYN100
*
* SYNTAX ERROR 01 LINE NUMBER OUT OF RANGE 1-2047
*
SYN060
MOVE LBIN1,W0 SAVE ERRONEUS POSITION
MOVE LBIN4,W1 SYNTAX ERROR:=1
B SYN980
EJECT
*
* CHECK IF INDENTION(LEADING SPACES
*
SYN100
CMP LBIN1,W1 CHECK IF LENGTH=1
BE SYN800 BASIC STATEMENT SEPARATOR
CMP LBIN4,LBIN1 CHECK E-O-B
BE SYN990 E-O-B FOUND
PERF INDCNT ***INDENTION COUNTING
BT SYN108 E-O-B JUST SPACES
MOVE LBIN3,W0 LOAD LOW LIMIT
TBF VBOOL1,SYN102 NO SPACE NEEDED IF NO LINE NO
ADD LBIN3,W1 ADJUST LOW LIMIT IF LINE NUMB
SYN102
CBL VBIN7,LBIN3,SYN105 JMP IF NUMB < 1 NOT OK
CBG VBIN7,=W'31',SYN103 JMP IF NUMBE > 31 NOT OK
B SYN110 OK
EJECT
*
* SYNTAX ERROR 03 INDENTION ERROR
*
SYN103
MOVE LBIN1,=W'31' LOAD ERRONEUS POSITION
B SYN106
SYN105
MOVE LBIN1,LBIN4 SAVE ERONEUS POSITION
SUB LBIN1,VBIN7 ADJUST POSITION
SYN106
MOVE LBIN4,W3 SYNTAX ERROR:=3
B SYN980 JMP ON ERROR
SYN108
SUB LBIN1,VBIN7 ADJUST LENGTH
DLETE LSTR81,LBIN1,VBIN7 DELETE TRAILING BLANKS
MOVE LBIN4,W80
ADD LBIN4,W1 CALC LENGTH OF INPUT BUFFER
SUB LBIN4,VBIN7 CALC START POINT
MOVE VBIN7,W80
ADD VBIN7,W1 CALC END LIMIT
MOVE LSTR1,=X'00' CLEAR
SYN109
XCOPY LSTR81,LBIN4,W1,LSTR1,W0 CLEAR POSITION
ADD LBIN4,W1 NEXT POSITION
CMP LBIN4,VBIN7 CHECK END LIMIT
BE SYN990 JMP IF END LIMIT REACHED
B SYN109
EJECT
*
* CHECK BASIC VERB
*
SYN110
CALL GETIND,STMTS,VBIN8,LBIN3 ---GET ITEM LENGTH
PERF BSVSEA,W2,VBIN6 ***BASIC VERB SEARCH LENGTH=2
BOK SYN120 BASIC VERB FOUND
PERF BSVSEA,W3,VBIN6 ***BASIC VERB SEARCH LENGTH=3
BOK SYN120 BASIC VERB FOUND
PERF BSVSEA,W4,VBIN6 ***BASIC VERB SEARCH LENGTH=4
BOK SYN118 BASIC VERB FOUND
PERF BSVSEA,W5,VBIN6 ***BASIC VERB SEARCH LENGTH=5
BOK SYN120 BASIC VERB FOUND
PERF VARDET ***VARIABLE/!INP/!FID
BNOK SYN112 NOT OK
PERF INDCNT ***INDENTION COUNTING
BT SYN904 E-O-B JUST SPACES
TBT VBOOL2,SYN111 ALPHANUM.VARIABLE
MOVE VBIN6,W2 NUMERIC LET WITHOUT LET
B SYN155 CONTINUE IN LET STMT
SYN111 MOVE VBIN6,W0 ALPHANUM.LET WITHOUT L
B SYN155
SYN112
CALL GETIND,STMTS,VBIN8,LBIN3 ---GET ITEM LENGTH
SUB VBIN8,W1 ADJUST POINTER
MATCH STMTS,VBIN8,W1,LSTR81,LBIN4,W1
BNOK SYN115
ADD LBIN4,W1 ADJUST BUFFER POINTER
B SYN800 BASIC STATEMENT SEPARATOR
*
* SYNTAX ERROR 02 BASIC VERB EXPECTED
*
SYN115
MOVE LBIN1,LBIN4 SAVE ERRONEUS POSITION
MOVE LBIN4,W2 SYNTAX ERROR :=2
B SYN980
*
* CHECK IF 'THEN' WAS FOUND
*
SYN118
CBNE VBIN6,W6,SYN120 JMP IF NOT 'THEN'
SUB LBIN4,W4 ADJUSTBUFFER POINTER
B SYN115 JMP WHEN T'THEN'
EJECT
*
* BASIC VERB FOUND OK
*
SYN120
IB VBIN6,SYN150, 1=ASSIGNMENT LET C
SYN150, 2=ASSIGNMNET C
SYN150, 3=ASSIGNMNET LET C
SYN200, 4=GO TO C
SYN200, 5=GOTO C
SYN250, 6=IF ..THEN ..<LINE> C
SYN115, 7=NOT VALID C
SYN250, 8=IF ..THEN ..<STMT> C
SYN115, 9=NOT VALID C
SYN350, 10=ON .. GO TO.. C
SYN350, 11=ON .. GOTO.. C
SYN400, 12=CALL C
SYN115, 13=NOT VALID C
SYN450, 14=SECT C
SYN115, 15=NOT VALID C
SYN500, 16=ATTR C
SYN115, 17=NOT VALID C
SYN550, 18=STOP C
SYN115, 19=NOT VALID C
SYN600, 20=EXIT C
SYN115, 21=NOT VALID C
SYN650, 22=ERR C
SYN115, 23=NOT VALID C
SYN650, 24=WARN C
SYN115, 25=NOT VALID C
SYN750, 26=REM C
SYN115, 27=NOT VALID C
SYN800 28=;
EJECT
*
* 1 LET <VARIABLE> = <ARITHMETIC EXPRESSION>/<STRING EXPRESSION>
*
SYN150
PERF INDCNT ***INDENTION COUNTING
BT SYN904 E-O-B JUST SPACES
CBL VBIN7,W1,SYN105 JMP IF NO INDENTION
*
* TARGET VARIABLE
*
PERF VARDET ***VARIABLE DETERMINATION
BNOK SYN905 JMP NOT OK
CMP LBIN4,LBIN1 CHECK E-O-B
BE SYN904 E-O-B JUST SPACES
PERF INDCNT ***INDENTION COUNTING
BT SYN904 E-O-B JUST SPACES
*
* ASSIGNMENT OPERATOR '='
*
SYN155
MOVE LBIN3,W0 POINTER:=0
MATCH OPRTS,LBIN3,W1,LSTR81,LBIN4,W1 MATCH '='
BNOK SYN906 NO ASSIGNMENT OPERATOR
ADD LBIN4,W1 ADJUST INPUT BUFFER POINTER
CMP LBIN4,LBIN1 CHECK E-O-B
BE SYN904 E-O-B JUST SPACES
PERF INDCNT ***INDENTION COUNTING
BT SYN904 E-O-B JUST SPACES
EJECT
PERF CLRLST ***CLEAR STACK
TBF VBOOL2,SYN160 JMP IF ARITHMETIC EXPR.
*
* STRING EXPRESSION EXPECTED
*
PERF STREXP ***STRING EXPR EVALUATION
BNOK SYN906 EXPR ERROR
B SYN800
*
* ARITHMETIC EXPRESSION EXPECTED
*
SYN160
PERF ARTEXP ***ARITHMETIC EXPR. EVALUATION
BNOK SYN906 EXPR ERROR
B SYN800 BASIC STATEMENT SEPARATOR ; ?
EJECT
*
* 4,5 GO TO/GOTO <LINE-NUMBER>
*
SYN200
PERF INDCNT ***INDENTION COUNTING
BT SYN904 E-O-B JUST SPACES
CMP VBIN7,W1 JMP IF NO INDENTION
BL SYN105 JMP IF LESS
*
* LABEL LINE NUMBER EXPECTED
*
PERF LABLIN,W4 ***LABEL LINE NUMBER
BNOK SYN907 LABEL LINE NUMBER ERROR
B SYN800 BASIC STATEMENT SEPARATOR ; ?
EJECT
*
* 6 IF <RELATIONAL EXPRESSION> THEN <LINE>/<STATEMENT>
*
SYN250
PERF INDCNT ***INDENTION COUNTING
BT SYN904 E-O-B JUST SPACES
CMP VBIN7,W1 JMP IF NO INDENTION
BL SYN105 JMP IF LESS
*
* STRING EXPRESSION EXPECTED
*
PERF CLRLST ***CLEAR STACK
PERF STREXP ***STRING EXPR EVALUATION
BOK SYN260 JMP OK
*
* ...OR ARITHMETIC EXPRESSION EXPECTED
*
PERF CLRLST ***CLEAR STACK
PERF ARTEXP ***ARITHMETIC EXPR. EVALUATION
BNOK SYN906 EXPR ERROR
EJECT
*
* RELATIONAL OPERATOR
*
SYN260
PERF INDCNT ***INDENTION COUNTING
BT SYN904 E-O-B NOT OK
MOVE LBIN3,W0 POINTER:=0
MATCH OPRTS,LBIN3,W3,LSTR81,LBIN4,W1
BNOK SYN904
MOVE LBIN3,W3 POINTER:=3
MATCH OPRTS,LBIN3,W6,LSTR81,LBIN4,W2 MATCH FOLLOWING OPERAND
BNOK SYN280 NO FOLLOWING OPERAND
ADD LBIN4,W1 ADJUST BUFFER POINTER
SYN280
ADD LBIN4,W1 ADJUST BUFFER POINTER
PERF INDCNT ***INDENTION COUNTING
BT SYN904 INCOMPLETE STATEMENT
EJECT
*
* STRING EXPRESSION EXPECTED
*
PERF CLRLST ***CLEAR STACK
TBF VBOOL2,SYN290 JMP IF ARITHMETIC
PERF STREXP ***STRING EXPR EVALUATION
BNOK SYN906
B SYN300
*
* ARITHMETIC EXPRESSION EXPECTED
*
SYN290
PERF ARTEXP ***ARITHMETIC EXPR. EVALUATION
BNOK SYN906 EXPR ERROR
SYN300
CMP LBIN4,LBIN1 CHECK E-O-B
BE SYN904 E-O-B OK
PERF INDCNT ***INDENTION COUNTING
BT SYN904 INCOMPLETE STATEMENT
CMP VBIN7,W1 CHECK NUMB OF SPACES
BL SYN105 JMP IF LESS
EJECT
*
* MATCH FOR THEN/
*
CALL GETIND,STMTS,VBIN8,LBIN3 ---GET ITEM LENGTH
MOVE LBIN12,=X'00FF' LOAD FILLER CHARACTER
PERF BSVSEA,W4,LBIN17 ***BASIC VERB SEARCH LENGTH=4
BNOK SYN904 INCOMPLETE STATEMENT
CMP LBIN17,W6 CHECK IF OP-CODE = 6
BE SYN305 JUMP IF 'THEN'
SUB LBIN4,W4 ADJUST BUFFER POINTER
B SYN904 INCOMPLETE STATEMENT/P
SYN305
PERF INDCNT ***INDENTION COUNTING
BT SYN904 INCOMPLETE STATEMNET
CMP VBIN7,W1 CHECK NUMB OF SPACES
BL SYN105 JMP IF LESS
*
* LABEL LINE NUMBER EXPECTED
*
PERF LABLIN,W4 ***LABEL LINE NUMBER
BNOK SYN110 NO LINE NUMBER STATEMENT
B SYN800 BASIC STATEMENT SEPARATOR ; ?
EJECT
*
* 10 ON <ARITHMETIC EXPRESSION> GO TO/GOTO <LINE-NUMBER-LIST>
*
SYN350
PERF INDCNT ***INDENTION COUNTING
BT SYN904 E-O-B JUST SPACES
CMP VBIN7,W1 JMP IF NO INDENTION
BL SYN105 JMP IF LESS
*
* ARITHMETIC EXPRESSION EXPECTED
*
PERF CLRLST ***CLEAR STACK
PERF ARTEXP ***ARITHMETIC EXPR EVALUATION
BNOK SYN906 EXPR ERROR
PERF INDCNT ***INDENTION COUNTING
BT SYN904 E-O-B NOT OK
CMP VBIN7,W1 CHECK NUMB OF SPACES
BL SYN105 JMP IF LESS
EJECT
*
* MATCH FOR GO TO/GOTO
*
CALL GETIND,STMTS,VBIN8,LBIN3 ---GET ITEM LENGTH
MOVE LBIN12,=X'00FF' LOAD FILLER CHARACTER
PERF BSVSEA,W4,LBIN17 ***BASIC VERB SEARCH LENGTH=4
BOK SYN356 BASIC VERB FOUND
PERF BSVSEA,W5,LBIN17 ***BASIC VERB SEARCH LENGTH=5
BOK SYN355 BASIC VERB FOUND
B SYN904 INCOMPLET STATEMNET
SYN355
CBE LBIN17,W4,SYN358 JMP IF GO TO
SUB LBIN4,W5
B SYN904
SYN356
CBE LBIN17,W5,SYN358 JMP IF GOTO
SUB LBIN4,W4 ADJUST BUFFER POINTER
B SYN904 INCOMPLETE STATEMENT
SYN358
PERF INDCNT ***INDENTION COUNTING
BT SYN904
CMP VBIN7,W1 CHECK NUMB OF SPACES
BL SYN105 JMP IF LESS
EJECT
*
* LABEL LINE NUMBER EXPECTED
*
SYN360
PERF LABLIN,W4 ***LABEL LINE NUMBER
BNOK SYN907 LABEL LINE NUMBER ERROR
CMP LBIN4,LBIN1 CHECK E-O-B
BE SYN990 E-O-B OK
PERF INDCNT ***INDENTION COUNTING
BT SYN108 E-O-B JUST SPACES
*
* MATCH FOR LABEL LIST SEPARATOR
*
MOVE LSTR1,=C',' SEPARATOR=,
MOVE LBIN3,W0 POINTER:=0
MATCH LSTR1,LBIN3,W1,LSTR81,LBIN4,W1 MATCH ','
BNOK SYN810 BASIC STATEMENT SEPARATOR ; ?
ADD LBIN4,W1 ADJUST BUFFER POINTER
CMP LBIN4,LBIN1 CHECK E-O-B
BE SYN904 INCOMPLETE STATEMENT
PERF INDCNT ***INDENTION COUNTING
BT SYN904 INCOMPLETE STATEMNET
B SYN360 NEXT LABEL LINE NUMBER
EJECT
*
* 12 CALL UF<DIGIT> !<PARAMETERLIST>!
*
SYN400
PERF INDCNT ***INDENTION COUNTING
BT SYN904 E-O-B JUST SPACES
CMP VBIN7,W1 JMP IF NO INDENTION
BL SYN105 JMP IF LESS
*
* USER FUNCTION IDENT 'UF'
*
MOVE VSTR2,=C'UF' USER FUNCTION IDENT ='UF'
MOVE LBIN3,W0 POINTER:=0
MATCH VSTR2,LBIN3,W2,LSTR81,LBIN4,W2 MATCH 'UF'
BNOK SYN904 INCOMPLETE STATEMENT
ADD LBIN4,W2 ADJUST BUFFER POINTER
CMP LBIN4,LBIN1 CHECK E-O-B
BE SYN904 INCOMPLETE STATEMENT
*
* FUNCTION NUMBER
*
PERF LABLIN,W2 ***LABEL LINE NUMBER
BNOK SYN904 INCOMPLETE STATEMENT
CMP LBIN4,LBIN1 CHECK E-O-B
BE SYN990
PERF INDCNT ***INDENTION COUNTING
BT SYN108 JUST SPACES AT E-O-B
EJECT
*
* BEGIN OF PARAMETER LIST '('
*
MOVE LSTR1,=C'(' LOAD LEFT PARENTHESIS
MOVE LBIN3,W0 POINTER:=0
MATCH LSTR1,LBIN3,W1,LSTR81,LBIN4,W1 MATCH '('
BNOK SYN810 BASIC STATEMENT SEPARATOR ; ?
SYN410
ADD LBIN4,W1 ADJUST BUFFER POINTER
PERF INDCNT ***INDENTION COUNTING
BT SYN904 INCOMPLETE STATEMNET
*
* STRING EXPRESSION EXPECTED
*
PERF CLRLST ***CLEAR STACK
PERF STREXP ***STRING EXPR EVALUATION
BOK SYN420 EXPR OK
*
* ... OR ARITHMETIC EXPRESSION
*
PERF CLRLST ***CLEAR STACK
PERF ARTEXP ***ARITHMETIC EXPR EVALUATION
BNOK SYN906 EXPR ERROR
SYN420
PERF INDCNT ***INDENTION COUNTING
BT SYN904 INCOMPLTTE STATEMENT
EJECT
*
* PARAMETER EXPRESSION SEPARATOR ','
*
MOVE LSTR1,=C',' LOAD PAR-SEPARATOR
MOVE LBIN3,W0 POINT0
MATCH LSTR1,LBIN3,W1,LSTR81,LBIN4,W1 MATCH ','
BOK SYN410 JMP IF OK
*
* END OF PARAMETER LIST
*
MOVE LSTR1,=C')' LOAD RIGHT PARENTHESIS
MOVE LBIN3,W0 POINTER:=0
MATCH LSTR1,LBIN3,W1,LSTR81,LBIN4,W1 MATCH ')'
BNOK SYN904 INCOMPLETE STATEMENT
ADD LBIN4,W1 ADJUST BUFFER POINTER
B SYN800 BASIC STATEMENT SEPARATOR ; ?
EJECT
*
* 14 SECT <STRING EXPRESSION>
*
SYN450
PERF INDCNT ***INDENTION COUNTING
BT SYN904 E-O-B JUST SPACES
CMP VBIN7,W1 JMP IF NO INDENTION
BL SYN105 JMP IF LESS
*
* STRING EXPRESSION EXPECTED
*
PERF CLRLST ***CLEAR STACK
PERF STREXP ***STRING EXPR EVALUATION
BNOK SYN906 EXPR ERROR
B SYN800 BASIC STATEMENT SEPARATOR ; ?
EJECT
*
* 16 ATTR <ATTRIBUTE> <DYNAMIC FIELD>
*
SYN500
PERF INDCNT ***INDENTION COUNTING
BT SYN904 E-O-B JUST SPACES
CMP VBIN7,W1 JMP IF NO INDENTION
BL SYN105 JMP IF LESS
*
* ATTRIBUTE => DECORATION OR PROTECTION
*
MOVE LBIN12,=W'26'
PERF DECSEA,LBIN12 ***DECORATION SEARCH
BNOK SYN904 JMP IF NOT OK
CMP LBIN4,LBIN1 CHECK E-O-B
BE SYN904 INCOMPLETE STATEMENT
PERF INDCNT ***INDENTION COUNTING
BT SYN904 INCOMPLETE STATEMENT
*
* MATCH FOR SEPARATOR
*
MOVE LSTR1,=C',' SEPARATOR=,
MOVE LBIN3,W0 POINTER:=0
MATCH LSTR1,LBIN3,W1,LSTR81,LBIN4,W1 MATCH ','
BNOK SYN904 INCOMPLETE STATEMENT
ADD LBIN4,W1 ADJUST BUFFER POINTER
CMP LBIN4,LBIN1 CHECK E-O-B
BE SYN904 INCOMPLETE STATEMENT
PERF INDCNT ***INDENTION COUNTING
BT SYN904 INCOMPLETE STATEMNET
*
* DYNAMIC FIELD
*
PERF VARDET ****VARIABLE DETERMINATION
BNOK SYN905 JMP IF NOT OK
TBF VBOOL3,SYN905 JMP IF NOT DYNAMIC FIELD
B SYN800 BASIC STATEMENT SEPARATOR ; ?
EJECT
*
* 18 STOP !<DYNAMIC FIELD>!
*
SYN550
CMP LBIN4,LBIN1 CHECK E-O-B
BE SYN990 E-O-B SIMPLE STOP OK
PERF INDCNT ***INDENTION COUNTING
BT SYN108 E-O-B JUST SPACES
CMP VBIN7,W1 JMP IF NO INDENTION
BL SYN105 JMP IF LESS
*
* STOP WITH TARGET DYNAMIC FIELD
*
PERF VARDET ****VARIABLE DETERMINATION
BNOK SYN810 BASIC STATEMENT SEPARATOR ; ?
TBF VBOOL3,SYN905 JMP IF NOT DYNAMIC FIELD
B SYN800 BASIC STATEMENT SEPARATOR ; ?
EJECT
*
* 20 EXIT <ARITHMETIC EXPRESSION>
*
SYN600
PERF INDCNT ***INDENTION COUNTING
BT SYN904 E-O-B JUST SPACES
CMP VBIN7,W1 JMP IF NO INDENTION
BL SYN105 JMP IF LESS
*
* ARITHMETIC EXPRESSION EXPECTED
*
PERF CLRLST ***CLEAR STACK
PERF ARTEXP ***ARITHMETIC EXPR EVALUATION
BNOK SYN906 EXPR ERROR
B SYN800 BASIC STATEMENT SEPARATOR ; ?
EJECT
*
* 22 ERR <DECORATION LIST> <STRING-EXPRESSION>
* 24 WARN <DECORATION LIST> <STRING-EXPRESSION>
*
SYN650
PERF INDCNT ***INDENTION COUNTING
BT SYN904 E-O-B JUST SPACES
CMP VBIN7,W1 JMP IF NO INDENTION
MOVE LBIN12,W0 NUMB OF FOUND DECORATIONS
CLEAR VBOOL5 FALSE DECORATIONS NOT READY
*
* DECORATION LIST
*
SYN660
CMP LBIN12,W5 CHECK IF ALREADY 5 DECORS
BE SYN675 INCOMPLETE STATEMENT
PERF DECSEA,W10 ***DECORATION SEARCH
BNOK SYN675 JMP IF NOT OK
CMP LBIN4,LBIN1 CHECK E-O-B
BE SYN904 INCOMPLETE STATEMENT
PERF INDCNT ***INDENTION COUNTING
BT SYN904 INCOMPLETE STATEMENT
ADD LBIN12,W1 INCREMENT NUMB OF DECORATIONS
EJECT
*
* MATCH FOR DECORATION LIST SEPARATOR
*
SYN670
MOVE LSTR1,=C',' SEPARATOR=,
MOVE LBIN3,W0 POINTER:=0
MATCH LSTR1,LBIN3,W1,LSTR81,LBIN4,W1 MATCH ','
BNOK SYN906 BASIC STATEMENT SEPARATOR ; ?
ADD LBIN4,W1 ADJUST BUFFER POINTER
CMP LBIN4,LBIN1 CHECK E-O-B
BE SYN904 INCOMPLETE STATEMENT
PERF INDCNT ***INDENTION COUNTING
BT SYN904 INCOMPLETE STATEMNET
B SYN660 NEXT DECORATION
*
* STRING EXPRESSION EXPECTED
*
SYN675
PERF CLRLST ***CLEAR STACK
PERF STREXP ***STRING EXPR EVALUATION
BNOK SYN906 EXPR ERROR
B SYN800 BASIC STATEMENT SEPARATOR ; ?
EJECT
*
* 26 REM !<ALPHNUMERIC CHARACTERS>!
*
SYN750
CMP LBIN4,LBIN1 CHECK E-O-B
BE SYN990 E-O-B SIMPLE STOP OK
PERF INDCNT ***INDENTION COUNTING
BT SYN108 E-O-B JUST SPACES
CMP VBIN7,W1
BL SYN105 JMP IF NO INDENTION
B SYN990
EJECT
*
* 28 ; (BASIC STATEMENT SEPARATOR)
*
SYN800
CMP LBIN4,LBIN1 CHECK E-O-B
BE SYN990 E-O-B
PERF INDCNT ***INDENTION COUNTING
BT SYN108 E-O-B JUST SPACES
*
* MATCH FOR BASIC STATEMENT SEPARATOR ;
*
SYN810
MOVE LSTR1,=C';' SEPARATOR=;
MOVE LBIN3,W0 POINTER:=0
MATCH LSTR1,LBIN3,W1,LSTR81,LBIN4,W1 MATCH ';'
BNOK SYN815 INCOMPLETE STATEMENT
ADD LBIN4,W1 ADJUST BUFFER POINTER
CMP LBIN4,LBIN1 CHECK E-O-B
BE SYN990 COMPLETE STATEMENT
SYN815
PERF INDCNT ***INDENTION COUNTING
BT SYN108 JUST SPACES
B SYN110 NEXT BASIC STATEMENT
EJECT
*
* SYNTAX ERROR 04 BASIC STATEMENT INCOMPLETE
*
SYN904
MOVE LBIN1,LBIN4 SAVE ERRONEUS POSITION
MOVE LBIN4,W4 SYNTAX ERROR:=4
B SYN980
*
* SYNTAX ERROR 05 ILLEGAL OPERAND
*
SYN905
MOVE LBIN1,LBIN4 SAVE ERRONEUS POSITION
MOVE LBIN4,W5 SYNTAX ERROR:=5
B SYN980
*
* SYNTAX ERROR 06 ILLEGAL EXPRESSION
*
SYN906
MOVE LBIN1,LBIN4 SAVE ERRONEUS POSITION
MOVE LBIN4,W6 SYNTAX ERROR:=6
B SYN980
*
* SYNTAX ERROR 07 NOT VALID LINE NUMBER
*
SYN907
MOVE LBIN1,LBIN4 SAVE ERRONEUS POSITION
MOVE LBIN4,W7 SYNTAX ERROR:=7
B SYN980
EJECT
*
* SYNTAX ERROR
*
SYN980
ADD LBIN1,W1 ADJUST POINTER POSITION
CMP W1,W0 CR:=1
B SYN999
*
* EXIT OK
*
SYN990
CMP W1,W1 CR:=0
SYN999
RET
PEND
EJECT
*
* BASIC VERB SEARCH
*
* INPUT : STLEN =(FORMAL) BASIC VERB LENGTH
*
* USED : VBIN7 = WORKITEM
*
* OUTPUT: LBIN4 = INPUT BUFFER POINTER ADJUSTED
* OPCODE = CORRESPONDING OBJECT-CODE (BASIC VERB)
* CR = 0 = OK
* = 1 = NOT OK
*
************************************************************************
BSVSEA PROC STLEN,OPCODE
PBIN STLEN
PBIN OPCODE
MOVE OPCODE,W0 BASIC-VERB OBJECT:=0
MOVE LBIN3,W0 POINTER:=0
MOVE LSTR1,=X'FF' LOAD FILLER
MATCH STMTS,LBIN3,VBIN8,LSTR81,LBIN4,STLEN BASICVERBMATCH
BNOK BSV999 JMP IF NOT FOUND
XCOPY OPCODE,W1,W1,STVAL,LBIN3 LOAD OBJECT CODE
CBE OPCODE,=X'00FF',BSV980 JMP IF FILLER
EJECT
*
* CHECK IF PROPER LENGTH
*
MOVE VBIN7,LBIN3 STORE POINTER VALUE
ADD VBIN7,STLEN ADD POINTER STATMENT LENGTH
MATCH STVAL,VBIN7,W1,LSTR1,W0,W1 MATCH IF FILLER
BOK BSV980 JMP IF FILLER /FF FOUND NOT OK
BSV100
ADD LBIN4,STLEN ADJUST POINTER WITH LENGTH
CMP W1,W1 CR:=0
B BSV999
BSV980
CMP W1,W0 CR:=1
BSV999
RET
PEND
EJECT
*
* INDENTION COUNTING
*
* INPUT : LSTR81 = INPUT BUFFER
* LBIN4 = INPUT BUFFER POINTER
* LBIN1 = LENGTH OF INPUT BUFFER
*
* OUTPUT: LBIN4 = ADJUSTED
* VBIN7 = NUMBER OF INDENTIONS
* CR = 0 = FALSE NOT E-O-BUFFER REACHED
* = 1 = TRUE E-O-BUFFER REACHED
*
************************************************************************
INDCNT PROC
MOVE LSTR1,=X'20' LOAD SPACE CHARACTER
MOVE VBIN7,W0 NUMB OF LEADING SPACES:=0
IND100
MOVE LBIN3,W0 MATCH-POINTER:=0
MATCH LSTR1,LBIN3,W1,LSTR81,LBIN4,W1 MATCH FOR SPACE
BNOK IND985 JMP IF NO MORE SPACES
ADD VBIN7,W1 INCREMENT NO OF SPACES
ADD LBIN4,W1 ADJUST BUFFER-POINTER
CMP LBIN4,LBIN1 CHECK E-O-B
BE IND980 E-O-B JUST SPACES
B IND100 GO ON
EJECT
IND980
CMP W1,W0 CR:=1
B IND999
IND985
CMP LBIN4,LBIN1 CHECK E-O-B
BE IND980 JMP IF E-O-B
IND990
CMP W1,W1 CR:=0
IND999
RET
PEND
EJECT
*
* VARIABLE DETERMINATION
*
* INPUT : LSTR81 = BASIC LINE
* LBIN4 = BASIC LINE POINTER
* FIDTAB = FIELD ID TABLE
* ATTAB = ATTRIBUTE TABLE
* GVDUR = SCREEN ROW BUFFER
*
* USED : LBIN3
* VBIN7
* VBIN8
* LBIN12
* LBIN17
*
* OUTPUT : VBOOL2 = FALSE NUMERIC => ARITHMETIC VARIABLE
* = TRUE ALPHANUM => STRING VARIABLE
* VBOOL3 = FALSE WSM-WORK-ITEM VARIABLE
* = TRUE DYNAMIC FIELD VARIABLE
* CR = 0 OK
* = 1 SYNTAX ERROR
*
************************************************************************
VARDET PROC
CLEAR VBOOL2 FALSE = ARITHMETIC VARIABLE
CLEAR VBOOL3 FALSE = WSM WORK ITEM VARIABLE
MOVE LBIN17,W4 VARIABLE LENGTH:=4
EJECT
*
* CURRENT FIELD '!FID' OR CURRENT INPUT '!INP'
*
MOVE LSTR9A,=C'!FID!INP!' LOAD IDENTIFIERS
MOVE LBIN3,W0 POINTER:=0
MATCH LSTR9A,LBIN3,W8,LSTR81,LBIN4,W4 MATCH '!FID' OR '!INP'
BNOK VAR100 JMP IF NOT FOUND
CBE LBIN3,W0,VAR010 JMP IF OK
CBE LBIN3,W4,VAR010 JMP IF OK
B VAR100 NOT OK
VAR010
TBF LBOOL5,VAR050 JMP IF CURRENT FIELD ARITHMETIC
B VAR250 CURRENT FIELD STRING
VAR050
B VAR300 LONG BRANCH CONSTRUCTION
EJECT
*
* WSM WORK ITEM INVESTIGATION
*
VAR100
MOVE LBIN3,W0 WORKITEM
MOVE LSTR6A,=C'WSWAWN' WSM-WORKITEN PREFIX
MATCH LSTR6A,LBIN3,W6,LSTR81,LBIN4,W2 SEARC WSMITEM PREFIX
BNOK VAR190 JMP IF NOT A WSM-ITEM
CBE LBIN3,W0,VAR102 JMP IF OK
CBE LBIN3,W2,VAR102 JMP IF OK
CBE LBIN3,W4,VAR102 JMP IF OK
B VAR190 JMP NOT OK
VAR102
MOVE LBIN12,LBIN4 LOAD CURRENT POINTER POSITION
ADD LBIN12,W2 ADJUST POINTER POSITION
XCOPY VSTR2,W0,W2,LSTR81,LBIN12 WSM ITEM NO
CBL VSTR2,=C'01',VAR108 LESS LOW LIMIT
CBL LBIN3,W2,VAR105 JMP IF
CBG VSTR2,=C'99',VAR108 GREATER HIGH LIMIT
B VAR110 JMP IF OK
VAR105
CBNG VSTR2,=C'09',VAR110 NOT GREATER HIGH LIMIT
VAR108
B VAR980 LONG BRANCH CONSTRUCTION
*
* WSM WORK-ITEM FOUND OK
*
VAR110
CBL LBIN3,W4,VAR250 ALPHANUM WSM-ITEM
B VAR300 NUMERIC
EJECT
*
* DYNAMIC FIELD INVESTIGATION
*
VAR190
SET VBOOL3 TRUE = DYNAMIC FIELD VARIABLE
MOVE LSTR6A,=X'422A5800' B*X=ALPHANUMERIC CHARS
MOVE LSTR16,=X'2B2D2A2F28293A263D3C3E2C3B2000' +-*/():&=<>,;B/00
MMOVE VBIN7,VBIN8,LBIN4 LOAD ACTUAL BUF. POPINTER
ADD VBIN7,W4 ADJUST TO GET MATCH-LIMIT
VAL192
MOVE LBIN3,W0 MATCHPOINTER:=0
MATCH LSTR16,LBIN3,W15,LSTR81,VBIN8,W1
BOK VAL194 DELIMITER-CHAR. FOUND
ADD VBIN8,W1 ADJUST TEMP BUFFER POINTER
CBE VBIN8,VBIN7,VAL194 4 POSITIONS MATCHED. JMP
B VAL192 GO ON MATCH DELIMITER
VAL194
SUB VBIN8,LBIN4 CALC EFF. FID-LENGTH ?
BE VAR980 IF = 0 => NO VARIABEL
MOVE LBIN3,W0 WORKITEM:=0
VAR200
CMP LBIN3,LABIN CHECK IF END ATTAB
BE VAR980 SYNTAX ERROR
XCOPY VBIN7,W0,W2,ATTAB,LBIN3 FETCH ROW & COL
CBE VBIN7,W0,VAR980 E-O-BUFFER
ADD LBIN3,W2 ADJUST ATAB-POINTER
XCOPY VBIN7,W0,W1,W0,W0 DELETE ROW NO
CBG VBIN7,LBIN9,VAR206 JMP IF OVFL ENTRY
XCOPY VBIN7,W1,W1,ATTAB,LBIN3 GET SEQ.NO
CBNE VBIN7,=X'00FF',VAR208 JMP IF DYNAMIC FIELD
VAR206
ADD LBIN3,W2 ADJUST ATTAB -POINTER
B VAR200 GO ON
*
* DYNAMIC FIELD SEQ.NO FOUND
*
VAR208
CALL WXMUL,VBIN7,W5,VBIN7
SUB VBIN7,W5 CALC FIELD-ID POSITION
MOVE LBIN12,VBIN7 LOAD FID-TAB POSITION
MATCH FIDTAB,LBIN12,W4,LSTR16,W13,W1 MATCH 1ST SPACE
SUB LBIN12,VBIN7 CALC FIDTAB-FID LENGTH
CBNE LBIN12,VBIN8,VAR206 JMP IF NOT SAME LENGTH
MATCH FIDTAB,VBIN7,VBIN8,LSTR81,LBIN4,VBIN8 MATCH FIELD NAME
BNOK VAR206 JMP IF NO FIELD ID
MOVE LBIN17,VBIN8 SAVE FOUND FID-LENGTH
EJECT
*
* RIGHT FIELD ID FOUND
*
SUB LBIN3,W2 ADJUST ATTAB-POINTER
MOVE VBIN7,W0 CLEAR FIRST
XCOPY VBIN7,W1,W1,ATTAB,LBIN3 GET ROW NO
ADD LBIN3,W1 ADJUST ATTAB-POINTER
MOVE VBIN8,W0 WORKITEM:=0
XCOPY VBIN8,W1,W1,ATTAB,LBIN3 GET COL NO
SUB VBIN8,W1 ADJUST COL.NR TO POINTER
ADD LBIN3,W3 ADJUST ATTAB-POINTER
CMP LBIN3,LABIN CHECK END OF ATTAB
BE VAR210 JMP IF E-O-B FOUND
MOVE LBIN12,W0 WORKITEM:=0
XCOPY LBIN12,W1,W1,ATTAB,LBIN3 GET NEXT ROW NO
CBNE LBIN12,VBIN7,VAR210 JMP IF NOT SAME ROW NO
ADD LBIN3,W1 ADJUST ATTAB-POINTER
XCOPY LBIN12,W1,W1,ATTAB,LBIN3 GET NEXT COL NO
SUB LBIN12,W1 ADUST ENDPOSITION
B VAR215
EJECT
*
* SEARCH FOR 1ST /00
*
VAR210
MOVE LBIN3,LBIN9 LOAD MAX COL POSITION
SUB LBIN3,VBIN8 CALC PICTURESTRING LENGTH
MOVE LBIN12,VBIN8 LOAD START POSITION
MATCH GVDUR(VBIN7),LBIN12,LBIN3,LSTR6A,W3,W1 MATCH 1ST 00
BOK VAR215 ENDPOS FOUND
MOVE LBIN12,LBIN9 ENDPOS=MAX ENDCOLPOS
VAR215
SUB LBIN12,VBIN8 CALC PICTURE LENGTH
MOVE LBIN3,W0 POINTER:=0
MATCH LSTR6A,LBIN3,W3,GVDUR(VBIN7),VBIN8,W1 MATCH 1ST CHAR
BNOK VAR300 NO ALPHANUM CHAR
*
* ALPHANUMERIC CHARACTER FOUND
*
XCOPY LSTR1,W0,W1,LSTR6A,LBIN3 LOAD FOUND SIGN
MOVE GST80I(W7),LSTR1 FILL WITH FOUND CHAR
MOVE LBIN3,W0 POINTER:=0
MATCH GST80I(W7),LBIN3,LBIN12,GVDUR(VBIN7),VBIN8,LBIN12
BNOK VAR300 ALL CHARACTERS NOT ALPHA
EJECT
*
* ALL CHARACTERS ARE ALPHANUMERIC => STRING VARIABLE
*
VAR250
SET VBOOL2 TRUE=ALPHANUMERIC =>STRING
*
* NUMERIC DYNAMIC FIELD => ARITHMETIC VARIABLE
*
VAR300
B VAR990 OK
*
* SYNTAX ERROR
*
VAR980
CMP W1,W0 CR:=1
B VAR999
*
* OK EXIT
*
VAR990
ADD LBIN4,LBIN17 ADJUST BUFFER-POINTER
CMP W1,W1 CR:=0
VAR999
RET
PEND
EJECT
*
* STRING EXPRESSION EVALUATION
*
* OUTPUT: CR = 0 OK
* = 1 NOT OK
* VBIN7 = NUMBER OF EXPRESSION CHARACTER
*
************************************************************************
STREXP PROC
ADD LBIN20,W1 INCREMENT-STACK-INDEX
CMP LBIN20,GBINIA(W5)
BG STR980 STACK OVERFLOW
*
* STRING CONSTANT
*
STR000
MOVE LSTR1,=X'22' LOAD STRING QUOTE "
MOVE LBIN3,W0 POINTER:=0
MATCH LSTR1,LBIN3,W1,LSTR81,LBIN4,W1 MATCH "
BNOK STR100 JMP IF NOTSTRING QUOTE
ADD LBIN4,W1 ADJUST FOR "
MOVE VBIN7,LBIN1 LOAD NUMB OF INPUT CHARACTERS
SUB VBIN7,LBIN4 CALC MATCH LENGTH
MOVE LBIN12,LBIN4 LOAD BUFFER POINTER
MATCH LSTR81,LBIN12,VBIN7,LSTR1,W0,W1 MATCH NEXT "
BNOK STR980 JMP IF NO STRINGQUOTE
MOVE LBIN4,LBIN12 STORE 2ND "-POSITION
ADD LBIN4,W1 ADJUST NUMB FOR 2ND "
B STR400 OK
EJECT
*
* STRING VARIABLE
*
STR100
PERF VARDET ***VARIABLE DETERMINATION
BNOK STR300 JMP IF NOT OK
TBT VBOOL2,STR200 JMP IF STRING VARIABLE
SUB LBIN4,LBIN17 ADJUST BUFFER POINTER WRONG
B STR980 SYNTAX ERROR
*
* QUALIFIED STRING VARIABLE ===> SUBSTRING
*
STR200
PERF INDCNT ***INDENTION COUNTING
BT STR990 E-O-B OK
*
* BEGIN OF SUBSTRING '('
*
MOVE LSTR1,=C'(' LOAD LEFT PARENTHESIS
MOVE LBIN3,W0 POINTER:=0
MATCH LSTR1,LBIN3,W1,LSTR81,LBIN4,W1 MATCH '('
BNOK STR410 NO SUBSTRING
ADD LBIN4,W1 ADJUST BUFFER POINTER
PERF INDCNT ***INDENTION COUNTING
BT STR980 INCOMPLETE STATEMNET
EJECT
*
* ARITHMETIC EXPRESSION EXPECTED
*
PERF ARTEXP ***ARITHMETIC EXPR EVALUATION
BNOK STR980 INCOMPLETE STATEMENT
PERF INDCNT ***INDENTION COUNTING
BT STR980 INCOMPLETE STATEMENT
*
* SUBSTRING OPERATOR ':'
*
MOVE LBIN3,W19 POINTER:=19
MATCH OPRTS,LBIN3,W1,LSTR81,LBIN4,W1 MATCH ':'
BNOK STR980 INCOMPLETE STATEMENT
ADD LBIN4,W1 ADJUST BUFFER POINTER
PERF INDCNT ***INDENTION COUNTING
BT STR980 INCOMPLETE STATEMENT
*
* ARITHMETIC EXPRESSION EXPECTED
*
PERF ARTEXP ***ARITHMETIC EXPR EVALUATION
BNOK STR980 INCOMPLETE STATEMENT
PERF INDCNT ***INDENTION COUNTING
BT STR980 INCOMPLETE STATEMENT
*
* END OF SUBSTRING
*
MOVE LSTR1,=C')' LOAD RIGHT PARENTHESIS
MOVE LBIN3,W0 POINTER:=0
MATCH LSTR1,LBIN3,W1,LSTR81,LBIN4,W1 MATCH ')'
BNOK STR980 INCOMPLETE STATEMENT
ADD LBIN4,W1 ADJUST BUFFER POINTER
B STR400 OK
*
* STRING FUNCTION ?
*
STR300
MOVE LBIN3,W20 POINTER:=20
MATCH OPRTS,LBIN3,W3,LSTR81,LBIN4,W3 MATCH FUNCTION
BNOK STR980 NO FUNCTION NOK
ADD LBIN4,W3 ADJUST BUFFER POINTER
PERF INDCNT ***INDENTION COUNTING
BT STR980 INCOMPLETE STATEMENT
EJECT
*
* BEGIN OF PARAMETER LIST '('
*
MOVE LSTR1,=C'(' LOAD LEFT PARENTHESIS
MOVE LBIN3,W0 POINTER:=0
MATCH LSTR1,LBIN3,W1,LSTR81,LBIN4,W1 MATCH '('
BNOK STR980 INCOMPLETE STATEMENT
ADD LBIN4,W1 ADJUST BUFFER POINTER
PERF INDCNT ***INDENTION COUNTING
BT STR980 INCOMPLETE STATEMNET
*
* ARITHMETIC EXPRESSION EXPECTED
*
PERF ARTEXP ***ARITHMETIC EXPR EVALUATION
BNOK STR980 INCOMPLETE STATEMENT
PERF INDCNT ***INDENTION COUNTING
BT STR980 INCOMPLTTE STATEMENT
*
* END OF PARAMETER LIST
*
MOVE LSTR1,=C')' LOAD RIGHT PARENTHESIS
MOVE LBIN3,W0 POINTER:=0
MATCH LSTR1,LBIN3,W1,LSTR81,LBIN4,W1 MATCH ')'
BNOK STR980 INCOMPLETE STATEMENT
ADD LBIN4,W1 ADJUST BUFFER POINTER
EJECT
*
* CONCATENATED STRING EXPRESSION ?
*
STR400
PERF INDCNT ***INDENTION COUNTING
BT STR990 E-O-B OK
STR410
MOVE LBIN3,W18 POINTER:=18
MATCH OPRTS,LBIN3,W1,LSTR81,LBIN4,W1 MATCH '&'
BNOK STR450 NO CONCA EXPR.
ADD LBIN4,W1 ADJUST BUFFER POINTER
PERF INDCNT ***INDENTION COUNTING
BT STR980 INCOMPLETE STATEMNET
B STR000 GO ON
STR450
SUB LBIN4,VBIN7 ADJUST BUFFERPOINTER
B STR990
*
* SYNTAX ERROR
*
STR980
SUB LBIN20,W1 DECREASE STACK INDEX
CMP W1,W0 CR:=1
B STR999
*
* EXIT OK
*
STR990
SUB LBIN20,W1 DECREASE STACK INDEX
SET VBOOL2 TRUE =STRING EXPRESSION
CMP W1,W1 CR:=0 OK
STR999
RET
PEND
EJECT
*
* ARITHMETC EXPRESSION EVALUATION
*
* OUTPUT: CR = 0 OK
* = 1 NOT OK
*
************************************************************************
ARTEXP PROC
ADD LBIN20,W1 INCREMENT-STACK-INDEX
CMP LBIN20,GBINIA(W5)
BG ART980 STACK OVERFLOW
*
* SIGNED FACTOR
*
ART000
MOVE LBIN3,W23 POINTER:=23
MATCH OPRTS,LBIN3,W2,LSTR81,LBIN4,W1 MATCH '+-'
BNOK ART050 NO SIGNED FACTOR
ADD LBIN4,W1 ADJUST BUFFER POINTER
PERF INDCNT ***INDENTION COUNTING
BT ART980 INCOMPLETE STATEMNET
EJECT
*
* ARITHMETIC CONSTANT
*
ART050
MOVE VBIN7,W0 NUMB OF CHARACTERS:=0
CLEAR VBOOL4 FALSE NO DECIMAL FOUND
ART060
XCOPY LSTR1,W0,W1,LSTR81,LBIN4 GET ONE CHARACTER
CBL LSTR1,=X'30',ART070 JMP IF NOT DIGIT BUT . OR ,
CBG LSTR1,=X'39',ART080 JMP IF NOT DIGIT
ART065
ADD VBIN7,W1 ADJUST NUMB OF CHARACTERS
ADD LBIN4,W1 ADJUST BUFFER POINTER
CMP LBIN4,LBIN1 CHECK E-O-B
BE ART500 OK EXIT
B ART060 GO ON
*
* DECIMAL CHARACTER FOUND ?
*
ART070
CBNE LSTR1,=C'.',ART080 JMP IF NOT A DIGIT
SET VBOOL4 TRUE DECIMAL FOUND
BOK ART065 OK 1ST DEC CHAR
*
* END OF DIGITS
*
ART080
CBE VBIN7,W0,ART100 NO DIGITS
CBG VBIN7,W1,ART500 AT LEAST ONE DIGIT OK
TBT VBOOL4,ART980 JMP IF JUST DECIMAL
B ART500 JMP OK
EJECT
*
* ARITHMETIC VARIABLE
*
ART100
PERF VARDET ***VARIABLE DETERMINATION
BNOK ART200 JMP IF SYNTAX ERROR
TBF VBOOL2,ART500 JMP IF ARITHMETIC VARIABLE
SUB LBIN4,LBIN17 ADJUST POINTER WRONG TYPE
B ART980 SYNTAX ERROR
*
* ARITHMETIC FUNCTION ?
*
ART200
CALL GETIND,OPRTS,VBIN7,LBIN3 ---GET ITEM LENGTH
MOVE LBIN3,=W'29' POINTER:=29
SUB VBIN7,LBIN3 CALC LENGTH TO MATCH
MATCH OPRTS,LBIN3,VBIN7,LSTR81,LBIN4,W3 MATCH FUNCTION
BNOK ART300 NO FUNCTION
MOVE LSTACK(LBIN20),W0 OPERATION CODE:=0
XCOPY LSTACK(LBIN20),W1,W1,OPRVAL,LBIN3 GET OP-CODE
ADD LBIN4,W3 ADJUST BUFFER POINTER
PERF INDCNT ***INDENTION COUNTING
BT ART980 INCOMPLETE STATEMENT
*
* BEGIN OF PARAMETER LIST '('
*
MOVE LSTR1,=C'(' LOAD LEFT PARENTHESIS
MOVE LBIN3,W0 POINTER:=0
MATCH LSTR1,LBIN3,W1,LSTR81,LBIN4,W1 MATCH '('
BNOK ART980 INCOMPLETE STATEMENT
ART210
ADD LBIN4,W1 ADJUST BUFFER POINTER
PERF INDCNT ***INDENTION COUNTING
BT ART980 INCOMPLETE STATEMNET
CBL LSTACK(LBIN20),=X'001D',ART230 ARITMETIC
CBL LSTACK(LBIN20),=X'001F',ART220 STRING
CBL LSTACK(LBIN20),=X'0021',ART230 ARITHMETIC
EJECT
*
* STRING EXPRESSION EXPECTED
*
ART220
PERF STREXP ***STRING EXPR EVALUATION
BNOK ART980 INCOMPLETE STATEMENT
B ART240
*
* ARITHMETIC EXPRESSION EXPECTED
*
ART230
PERF ARTEXP ***ARITHMETIC EXPR EVALUATION
BNOK ART980 INCOMPLETE STATEMENT
ART240
PERF INDCNT ***INDENTION COUNTING
BT ART980 INCOMPLTTE STATEMENT
CBL LSTACK(LBIN20),=X'001F',ART250 JMP NO MORE PARAM
*
* PARAMETER EXPRESSION SEPARATOR ','
*
SUB LSTACK(LBIN20),W4 ADJUST OP-CODE
MOVE LSTR1,=C',' LOAD PAR-SEPARATOR
MOVE LBIN3,W0 POINT0
MATCH LSTR1,LBIN3,W1,LSTR81,LBIN4,W1 MATCH ','
BNOK ART980 INCOMPLETE STATEMENT
B ART210 NEXT PARAMETER
EJECT
*
* END OF PARAMETER LIST
*
ART250
MOVE LSTR1,=C')' LOAD RIGHT PARENTHESIS
MOVE LBIN3,W0 POINTER:=0
MATCH LSTR1,LBIN3,W1,LSTR81,LBIN4,W1 MATCH ')'
BNOK ART980 INCOMPLETE STATEMENT
ADD LBIN4,W1 ADJUST BUFFER POINTER
B ART500
EJECT
*
* PRIORED EXPRESSION ( <ARITHMETIC EXPRESSION> )
* BEGIN OF PRIORED EXPRESSION '('
*
ART300
MOVE LSTR1,=C'(' LOAD LEFT PARENTHESIS
MOVE LBIN3,W0 POINTER:=0
MATCH LSTR1,LBIN3,W1,LSTR81,LBIN4,W1 MATCH '('
BNOK ART500 NO PRIORED EXPRESSION
ADD LBIN4,W1 ADJUST BUFFER POINTER
PERF INDCNT ***INDENTION COUNTING
BT ART980 INCOMPLETE STATEMNET
*
* ARITHMETIC EXPRESSION EXPECTED
*
PERF ARTEXP ***ARITHMETIC EXPR EVALUATION
BNOK ART980 INCOMPLETE STATEMENT
PERF INDCNT ***INDENTION COUNTING
BT ART980 INCOMPLETE STATEMENT
EJECT
*
* END OF PRIORED EXPRESSION
*
MOVE LSTR1,=C')' LOAD RIGHT PARENTHESIS
MOVE LBIN3,W0 POINTER:=0
MATCH LSTR1,LBIN3,W1,LSTR81,LBIN4,W1 MATCH ')'
BNOK ART980 INCOMPLETE STATEMENT
ADD LBIN4,W1 ADJUST BUFFER POINTER
EJECT
*
* COMBINED FACTOR MULTIPLY OPERATOR
*
ART500
PERF INDCNT ***INDENTION COUNTING
BT ART990 END OF LINE OK
MOVE LBIN3,=W'27' POINTER:=27
MATCH OPRTS,LBIN3,W2,LSTR81,LBIN4,W1 MATCH '/*'
BNOK ART600 NO MULTIPLY OPERATOR
ADD LBIN4,W1 ADJUST BUFFER POINTER
PERF INDCNT ***INDENTION COUNTING
BT ART980 INCOMPLETE STATEMENT
B ART050 GO ON
*
* COMBINED EXPRESSION ADDING OPERATOR ?
*
ART600
MOVE LBIN3,=W'25' POINTER:=25
MATCH OPRTS,LBIN3,W2,LSTR81,LBIN4,W1 MATCH '+-'
BNOK ART650 NO SIGN-OPERATOR
ADD LBIN4,W1 ADJUST BUFFER POINTER
PERF INDCNT ***INDENTION COUNTING
BT ART980 INCOMPLETE STATEMNET
B ART050 GO ON
ART650
SUB LBIN4,VBIN7 ADJUST BUFFER POINTER
B ART990 OK EXIT
EJECT
*
* SYNTAX ERROR
*
ART980
SUB LBIN20,W1 DECREASE STACK-INDEX
CMP W1,W0 CR:=1
B ART999
*
* OK EXIT
*
ART990
SUB LBIN20,W1 DECREASE STACK-INDEX
CLEAR VBOOL2 FALSE = ARITHMETIC EXPR
CMP W1,W1 CR:=0
ART999
RET
PEND
EJECT
*
* LABEL LINE NUMBER
*
* INPUT : LSTR81 = BASIC LINE
* LBIN4 = BASIC LINE POINTER
* LBIN1 = INPUT BUFFER LENGTH
* LENGTH = (FORMAL) MAX LENGTH OF NUMBER TO BE CONTROLL
*
* USED : LSTR1
*
* OUTPUT : CR = 0 OK
* = 1 NOT OK
* VBIN7 = NUMBER OF EXPRESSION CHARACTER
*
************************************************************************
LABLIN PROC LENGTH
PBIN LENGTH
CALL ICLEAR,LSTR4A ---CLEAR ITEM
MOVE VBIN7,W0 NUMB OF LINE-NUMB CHARS:
LAB100
XCOPY LSTR1,W0,W1,LSTR81,LBIN4 GET ONE CHARACTER
CBL LSTR1,=X'30',LAB150 JMP IF NOT A DIGIT
CBG LSTR1,=X'39',LAB150 JMP IF NOT A DIGIT
XCOPY LSTR4A,VBIN7,W1,LSTR1,W0 STORE DIGIT
ADD VBIN7,W1 ADJUST LINE NUMBER LENGTH
ADD LBIN4,W1 ADJUST POINTER
CBE LBIN4,LBIN1,LAB150 JMP IF E-O-B
CBNE VBIN7,LENGTH,LAB100 JMP IF NOT MAXLENGTH
EJECT
LAB150
CALL EMPTYT,LSTR4A ---CHECK IF EMPTY
BNOK LAB980 JMP IF NO LINE NUMBER
MOVE LINNO(W9),LSTR4A CONVERT TO BCD
MOVE LBIN3,LINNO(W9) CONVERT TO BINARY
CBL LBIN3,W1,LAB160 JMP IF OUT OF RANGE
CBG LBIN3,=X'07FF',LAB980 JMP IF OUT OF RANGE
B LAB990
LAB160
CBNE VBIN6,W12,LAB980 JMP IF NOT 'CALL'-FUNCTION
CBE LBIN3,W0,LAB990 0=OK WHEN 'CALL'
B LAB980 JMP NOT OK
*
* LINE NUMBER FOUND OK
*
LAB990
CMP W1,W1 CR:=0
B LAB999 EXIT
*
* SYNTAX ERROR
*
LAB980
CMP W1,W0 CR:=1
LAB999
RET
PEND
EJECT
*
* DECORATION SEARCH
*
* INPUT : LSTR81 = BASIC LINE
* LBIN4 = BASIC LINE POINTER
* LBIN1 = LENGTH OF BASIC LINE
* DSTLEN = (FORMAL) DECOR-STRING LENGTH
* DECOR = DECOR STRING
*
* USED : LSTR1
* LBIN3
* LBIN17
*
* OUTPUT: CR = 0 OK
* = 1 NOT OK
*
************************************************************************
DECSEA PROC DSTLEN
PBIN DSTLEN
EJECT
*
* DECORATION DELIMITER
*
MOVE LBIN17,LBIN4 SAVE BUFFER POINTER
MOVE LSTR1,=X'22' LOAD STRING QUOTE "
MOVE LBIN3,W0 POINTER:=0
MATCH LSTR1,LBIN3,W1,LSTR81,LBIN17,W1 MATCH "
BNOK DEC980 JMP IF NOT FOUND
ADD LBIN17,W1 ADJUST BUFFER POINTER
CMP LBIN17,LBIN1 CHECK END OF LINE
BE DEC980 JMP IF E-O-B
*
* DECORATION VERB
*
MOVE LBIN3,W0
MATCH DECOR,LBIN3,DSTLEN,LSTR81,LBIN17,W2 MATCH DECOR
BNOK DEC980 JMP IF NOT FOUND
XCOPY LSTR1,W0,W1,DECVAL,LBIN3 GET OP-CODE
CBE LSTR1,=X'FF',DEC980 JMP IF FILLER
ADD LBIN17,W2 ADJUST BUFFER POINTER
CMP LBIN17,LBIN1 CHECK E-O-B
BE DEC980
*
* DECORATION DELIMITER "
*
MOVE LSTR1,=X'22' LOAD STRING QUOTE "
MOVE LBIN3,W0 POINTER:=0
MATCH LSTR1,LBIN3,W1,LSTR81,LBIN17,W1 MATCH "
BNOK DEC980 JMP IF NOT FOUND
EJECT
*
* OK EXIT
*
ADD LBIN4,W4 ADJUST BUFFER POINTER
CMP W1,W1 CR:=0 OK
B DEC999
*
* SYNTAX ERROR
*
DEC980
CMP W1,W0 CR:=1
DEC999
RET
PEND
EJECT
*
* CLEAR LSTACK
*
* INPUT : LSTACK = STACK-INFORMATION
*
* USED : LBIN20 = STACK-INDEX
*
* OUPUT : LBIN20 = STACK-INDEX = 0
*
************************************************************************
CLRLST PROC
CALL GETIND,LSTACK(W1),LBIN20,LBIN3 ---GET LENGTH & DIMENSION
MOVE LBIN20,W1 STACK-INDEX:=1
CLR010
CALL ICLEAR,LSTACK(LBIN20) ---CLEAR ITEM
ADD LBIN20,W1 INCREMENT STACK-INDEX
CMP LBIN20,LBIN3 WHOLE STACK CLEARED
BG CLR999
B CLR010 GO ON
CLR999
MOVE LBIN20,W0 STACK INDEX:=0
CALL WXDIV,LBIN3,W2,LBIN3 DIVIDE STACK DIMENSION
MOVE GBINIA(W5),LBIN3 LOAD DIMENSION FOR SYNTAX
RET
PEND
END