CONST INTEGER DIAGOP = 0; ! Non-zero for diagnostic tracing code.
CONST INTEGER ULCEQUIV = -1
! Zero to distinguish upper form lower case in keywords,
! non-zero to treat upper and lower case as equivalent.
!
RECORD FORMAT PD (INTEGER BOUND, ADDRESS)
!
!
IF ULCEQUIV#0 THEN START
SYSTEM ROUTINE SPEC UCTRANSLATE (INTEGER ADDR, LIM)
FINISH
IF DIAGOP#0 THEN START
EXTERNAL ROUTINE LIST PARAMETERS C
(INTEGER P, C
STRING ARRAY NAME KNAME, C
RECORD ARRAY NAME VALUE)
RECORD SPEC VALUE (PD)
INTEGER I, J, K, L
IF P>0 THEN START
CYCLE I=1,1,P
L = ADDR (KNAME(I))
L = BYTE INTEGER (L)
PRINT STRING (KNAME(I))
SPACES (12-LENGTH(KNAME(I)))
PRINT SYMBOL ('"')
K = VALUE(I)_BOUND & X'00FFFFFF'
IF K>0 THEN START
L = VALUE(I)_ADDRESS
CYCLE J=L,1,L+K-1
PRINT SYMBOL (BYTE INTEGER(J))
REPEAT
FINISH
PRINT SYMBOL ('"')
NEWLINE
REPEAT
FINISH
END
FINISH
!
SYSTEM ROUTINE ANALYSE PARAMETERS C
(STRING NAME DCL PARMS, CALL PARMS, INTEGER MAX PARMS, C
STRING ARRAY NAME KEYS, INTEGER MAX KEY SIZE, C
RECORD ARRAY NAME ACTUAL, C
INTEGER NAME TOTAL KEYS, RESPONSE)
!
! THIS ROUTINE TAKES TWO 'PARAMETER STRINGS', 'DCL PARMS' FROM A
! MACRO DECLARATION AND 'CALL PARM' FROM A CALL OF THE SAME MACRO.
! IT PRODUCES IN THE %STRING %ARRAY 'KEYS' ALL THE KEYWORDS DECLARED IN
! THE MACRO DECLARATION, IN THE CORRECT ORDER, AND IN %RECORD %ARRAY
! 'ACTUAL', BYTE-VECTOR DESCRIPTORS TO THE CORRESPONDING ACTUAL
! PARAMETER TEXTS TO BE USED IN THE CALL. THESE DESCRIPTORS WILL BE
! TO AREAS WITHIN THE %STRING 'CALL PARMS' OR (WHERE A DEFAULT IS
! USED) WITHIN 'DCL PARMS'. A DESCRIPTOR WITH BOUND ZERO WILL
! INDICATE A NULL STRING.
! THE VALUES OF 'MAX PARMS' AND 'MAX KEY SIZE' MUST BE SET ON ENTRY
! TO INDICATE THE MAXIMUM NUMBER OF PARAMETERS AND THE MAXIMUM LENGTH
! OF THE KEYWORD STRINGS WHICH CAN BE ACCEPTED. THE %ARRAYS 'KEYS'
! AND 'ACTUAL' MUST BE DECLARED WITH UPPER BOUNDS NOT LESS THAN
! 'MAX PARMS' AND LOWER BOUNDS OF 1. THE %STRINGS IN %ARRAY 'KEYS'
! MUST HAVE MAXIMUM LENGTH NOT LESS THAN 'MAX KEY SIZE'.
! ON EXIT, 'RESPONSE' WILL BE =0 FOR SUCCESS, >0 FOR WARNINGS AND
! <0 FOR FAILURE. AS WELL AS THE SIGN BIT, OTHER BITS MAY BE SET
! TO INDICATE SPECIFIC WARNING OR ERROR CONDITIONS.
! BIT 24 (VALUE 128)- KEYWORDS INDISTINCT: TWO KEYWORDS HAVE THE
! SAME FIRST CHARACTERS, SO THAT THEIR
! ABBREVIATIONS COULD NOT BE DISTINGUISHED
! IN A CALL.
! BIT 25 (VALUE 64) - 'WRAP-AROUND': FIRST CHARACTER HAS BEEN
! SPECIFIED BY POSITION, BUT NOT IN FIRST
! POSITION IN THE CALL.
! BIT 26 (VALUE 32) - SOME PARAMETER SPECIFIED MORE THAN ONCE:
! LATEST VALUE ACCEPTED.
! BIT 27 (VALUE 16) - UNRECOGNISED KEYWORD IN CALL: FIELD IGNORED.
! BIT 28 (VALUE 8) - KEYWORD TOO LONG IN CALL:
! EXTRA CHARACTERS IGNORED.
! BIT 29 (VALUE 4) - TOO MANY FIELDS IN DECLARATION.
! BIT 30 (VALUE 2) - KEYWORD TOO LONG IN DECLARATION:
! EXTRA CHARACTERS IGNORED.
! BIT 31 (VALUE 1) - FIELD WITH NO KEYWORD IN DECLARATION.
!
! IF 'RESPONSE'>=0, THEN 'TOTAL KEYS' WILL ALSO BE SET TO INDICATE HOW
! MANY PARAMETERS THERE ARE.
!
!
ROUTINE PICK UNIT (INTEGER NAME CHAD, CHEND, C
INTEGER DECL, STRING NAME KEYWORD, INTEGER KSIZE, C
INTEGER NAME VLIM, VADDR, INTEGER NAME R)
! THIS ROUTINE SCANS BYTES FROM ADDRESS CHAD+1 TO
! ADDRESS CHEND (INCREMENTING CHAD AS IT GOES), TO FIND
! A KEYWORD AND/OR A PARAMETER VALUE. IT COPIES THE KEYWORD
! INTO THE PARAMETER 'KEYWORD', AND PUTS THE LENGTH AND
! ADDRESS OF THE PARAMETER VALUE INTO VLIM AND VADDR
! RESPECTIVELY.
! VADDR WILL BE BETWEEN (INITIAL VALUE OF) CHAD + 1 AND
! THE FINAL VALUE OF CHAD - 1. VLIM+VADDR-1 WILL ALSO LIE
! IN THAT RANGE. VLIM WILL NOT BE LESS THAN ZERO.
! ON ENTRY, CHAD MUST HAVE (ADDRESS OF THE FIRST CHARACTER
! TO BE EXAMINED) - 1. CHEND MUST HAVE THE ADDRESS OF THE
! LAST CHARACTER TO BE EXAMINED. ON EXIT, CHAD WILL HAVE BEEN
! UPDATED TO POINT TO THE LAST CHARACTER EXAMINED. IF IT
! IS THEN GREATER THAN CHEND, THE ORIGINAL TEXT HAS BEEN
! EXHAUSTED. IF IT IS EQUAL TO CHEND, THEN THE LAST CHARACTER
! OF THE ORIGINAL TEXT WAS THE COMMA WHICH TERMINATED THE
! PARAMETER FIELD. IF CHAD IS GREATER THAN OR EQUAL TO CHEND ON
! ENTRY, THEN THE ROUTINE WILL RETURN IMMEDIATELY WITH CHAD
! UNALTERED, WITH A NULL STRING IN KEYWORD, AND WITH VLIM=0.
! THERE WILL BE NO ERROR INDICATION IN THIS CASE.
! IF NO KEYWORD IS DETECTED IN A CALL ON PICK UNIT, THEN
! KEYWORD WILL BE ASSIGNED A NULL STRING. IF NO PARAMETER
! VALUE IS DETECTED, OR IF THE VALUE IS A NULL STRING, THEN
! VLIM WILL BE ZERO. WHERE A FIELD CONTAINS NO "=" SYMBOL
! (AND WHEN THERE IS NO OTHER WAY OF RESOLVING THE AMBIGUITY),
! THE VALUE OF THE PARAMETER DECL DECIDES WHETHER ANY TEXT
! FOUND IS TO BE TAKEN TO BE A KEYWORD (APPROPRIATE IN
! ANALYSING MACRO DECLARATIONS: DECL NON-ZERO) OR A
! PARAMETER VALUE (APPROPRIATE IN ANALYSING A CALL: DECL ZERO).
! THE PARAMETER KSIZE SPECIFIES THE MAXIMUM PERMISSIBLE SIZE OF
! THE STRING KEYWORD.
! ERRORS ARE NOTIFIED BY THE VALUE OF R ON EXIT. A ZERO VALUE
! MEANS THAT NO ERRORS HAVE OCCURRED. THE ONLY ERROR CONDITION
! DEFINED SO FAR IS "KEYWORD TOO LONG", GIVING R=1.
INTEGER TS, KADDR, KLIM, CHIN, CHYPE, BL, PAST
!
! THE ARRAY 'PROCN' IS INDEXED BY 'CHYPE' AND 'PAST' TO SELECT A
! DESTINATION IN THE SWITCH 'PROCN'. THIS PASSES CONTROL TO A
! PROCESS APPROPRIATE TO THE PRESENT STATE OF THE ANALYSIS ('PAST')
! AND THE CHARACTER BEING INSPECTED IN THE PARAMETER STRING ('CHYPE').
! VALUES OF 'CHYPE' ARE:
! 0 - NO TEXT LEFT TO EXAMINE;
! 1 - LETTER;
! 2 - DIGIT;
! 3 - SPACE;
! 4 - COMMA;
! 5 - 'EQUALS' SIGN;
! 6 - OPEN BRACKET;
! 7 - CLOSE BRACKET;
! 8 - DOUBLE-QUOTE;
! 9 - ANYTHING ELSE.
! VALUES OF 'PAST' ARE:
! 1 - STARTING: NO NON-SPACE CHARACTER SEEN YET.
! 2 - TEXT FOUND, BUT STILL UNDECIDED WHETHER IT IS KEYWORD OR VALUE.
! 3 - PROCESSING THE 'VALUE' PART OF THE PARAMETER FIELD.
! 4 - IN QUOTES (AND THIS CAN ONLY BE IN THE VALUE PART).
CONST BYTE INTEGER ARRAY PROCN (0:9,1:4) = C
16, 10, 8, 0, 16, 8, 9, 8, 7, 8,
15, 11, 11, 2, 15, 4, 9, 8, 7, 8,
14, 1, 1, 3, 14, 1, 12, 13, 6, 1,
17, 1, 1, 2, 1, 1, 1, 1, 5, 1
! %STRING (1) CHST
! %STRING (5) DISCARD
! %CONST %STRING (6) SPC = " ,=()"""
SWITCH PERFORM (0:17)
! LENGTH (CHST) = 1
R = 0
KADDR = ADDR (KEYWORD)
KLIM = 0
VADDR = CHAD + 1
VLIM = 0
BL = 0
PAST = 1
TS = 0
-> SEECH
!
!
PERFORM(10):
PAST = 2
PERFORM(11):
IF KLIM>=KSIZE C
THEN R = R ! 1 C
ELSE START
KLIM = KLIM + 1
BYTE INTEGER (KADDR+KLIM) = CHIN
FINISH
PERFORM(1):
ADD NS:
TS = 0
ADD TO F:
VLIM = VLIM + 1
!
SEECH:
CHAD = CHAD + 1
IF CHAD>CHEND THEN -> PERFORM (PROCN(0,PAST))
CHIN = BYTE INTEGER (CHAD)
!
! **** **** THIS NEXT SECTION IS A CANDIDATE **** ****
! **** **** FOR MACHINE CODING, BUT FOR THE **** ****
! **** **** MOMENT I HAVE USED A BIT OF **** ****
! **** **** TRICKERY WITH %STRINGS SPC, CHST **** ****
! **** **** AND DISCARD. THEIR DECLARATIONS **** ****
! **** **** WILL NOT BE NEEDED IF THIS BIT **** ****
! **** **** OF CODE IS REPLACED. **** ****
! **** **** IN FACT MY NEW CODE ACTUALLY **** ****
! **** **** TAKES MORE SPACE THAN THE OLD, **** ****
! **** **** SO I HAVE COMMENTED IT OUT, BUT **** ****
! **** **** I HAVE LEFT THE TEXT HERE AS AN **** ****
! **** **** INDICATION OF THE SORT OF CODE **** ****
! **** **** I HAD IN MIND. **** ****
IF 'A'<=CHIN<='Z' C
OR (ULCEQUIV#0 AND 'a'<=CHIN<='z') C
THEN CHYPE = 1 ELSE START
IF '0'<=CHIN<='9' THEN CHYPE = 2 ELSE START
IF CHIN=' ' THEN CHYPE = 3 ELSE START
IF CHIN=',' THEN CHYPE = 4 ELSE START
IF CHIN='=' THEN CHYPE = 5 ELSE START
IF CHIN='(' THEN CHYPE = 6 ELSE START
IF CHIN=')' THEN CHYPE = 7 ELSE START
IF CHIN='"' THEN CHYPE = 8 ELSE CHYPE = 9
FINISH
FINISH
FINISH
FINISH
FINISH
! EQUIVALENT TO THAT, AND (I HOPE) FASTER AND MORE COMPACT:
! BUT IN FACT IT TAKES MORE SPACE, AND I HAVE NOT CHECKED ITS
! SPEED!
! BYTE INTEGER (ADDR(CHST)+1) = CHIN
! %IF SPC->DISCARD.(CHST) %C
! %THEN CHYPE = LENGTH(RESIDUE) + 3 %C
! %ELSE CHYPE = 9
FINISH
FINISH
! **** **** END OF MACHINE CODE SECTION **** ****
!
-> PERFORM (PROCN(CHYPE,PAST))
!
PERFORM(9):
BL = 1
PERFORM(8):
KLIM = 0
PERFORM(5):
PAST = 3
-> ADD NS
!
PERFORM(7):
KLIM = 0
PERFORM(6):
PAST = 4
-> ADD NS
!
PERFORM(4):
VADDR = CHAD + 1
VLIM = 0
TS = 0
PAST = 3
-> SEECH
!
PERFORM(3):
IF VLIM#0 THEN -> ADD S
PERFORM(0):
VADDR = VADDR + 1
-> SEECH
PERFORM(2):
ADD S:
TS = TS + 1
-> ADD TO F
!
PERFORM(12):
BL = BL + 1
-> ADD NS
!
PERFORM(13):
IF BL>0 THEN BL = BL - 1
-> ADD NS
!
PERFORM(14):
IF BL>0 THEN -> ADD NS
-> UNIT COMPLETE
!
PERFORM(15):
IF DECL=0 THEN KLIM = 0 ELSE TS = VLIM
PERFORM(17):
UNIT COMPLETE:
VLIM = VLIM - TS
PERFORM(16):
LENGTH (KEYWORD) = KLIM
IF ULCEQUIV=0 THEN START
IF KLIM=0 THEN R = R & X'FFFFFFFE'
FINISH ELSE START
IF KLIM=0 THEN R = R & X'FFFFFFFE' ELSE UCTRANSLATE (KADDR+1,KLIM)
FINISH
RETURN
END
!
!
INTEGER CPTR, CLIM, RESULT, VS, VP, L, M, KM, KN, CSTART
INTEGER WRAPPING, KEY VALID
INTEGER NAME VALSIZE, VALPTR
RECORD NAME VAL (PD)
STRING (255) CALL KEY, RESIDUE
STRING NAME THIS KEY, THAT KEY
!
RESPONSE = 0
CPTR = ADDR (DCL PARMS)
CLIM = CPTR + LENGTH (DCL PARMS)
IF CLIM=CPTR THEN START
TOTAL KEYS = 0
RETURN
FINISH
KN = 0
WHILE CPTR<CLIM AND KN<MAX PARMS CYCLE
KN = KN + 1
THIS KEY == KEYS (KN)
VAL == ACTUAL (KN)
VALSIZE == VAL_BOUND
VALPTR == VAL_ADDRESS
PICK UNIT (CPTR,CLIM,-1,THIS KEY,MAX KEY SIZE,VALSIZE,VALPTR,RESULT)
VALSIZE = VALSIZE ! X'18000000'
L = LENGTH (THIS KEY)
IF L=0 THEN START
RESPONSE = RESPONSE ! X'80000001'
CPTR = CLIM + 1
FINISH ELSE START
IF RESULT#0 THEN RESPONSE = RESPONSE ! 2
KM = 1
IF L>3 THEN L=3
WHILE KM<KN CYCLE
THAT KEY == KEYS (KM)
M = LENGTH (THAT KEY)
IF M>L THEN M=L
!
! **** **** MACHINE CODE HERE? **** ****
IF FROM STRING(THIS KEY,1,M)=FROM STRING(THAT KEY,1,M) C
THEN RESPONSE = RESPONSE ! X'80000080'
! **** **** END OF MACHINE CODE **** ****
!
KM = KM + 1
REPEAT
FINISH
REPEAT
IF CPTR<=CLIM THEN RESPONSE = RESPONSE ! X'80000004'
IF RESPONSE<0 THEN RETURN
TOTAL KEYS = KN
KN = 1
WRAPPING = 0
CSTART = ADDR (CALL PARMS)
CPTR = CSTART
CLIM = CPTR + LENGTH (CALL PARMS)
WHILE CPTR<CLIM CYCLE
PICK UNIT (CPTR,CLIM,0,CALL KEY,MAX KEY SIZE,VS,VP,RESULT)
IF RESULT#0 THEN RESPONSE = RESPONSE ! 8
KEY VALID = 0
IF LENGTH(CALL KEY)>0 THEN START
KN = 0
IF LENGTH(CALL KEY)<3 THEN START
UNTIL KN>TOTAL KEYS OR KEYS(KN)=CALL KEY CYCLE
KN = KN + 1
REPEAT
FINISH ELSE START
UNTIL KN>TOTAL KEYS C
OR KEYS(KN)->(CALL KEY).RESIDUE C
CYCLE
KN = KN + 1
REPEAT
FINISH
IF KN>TOTAL KEYS THEN START
RESPONSE = RESPONSE ! X'00000010'; ! UNRECOGNISED KEYWORD.
FINISH ELSE START
KEY VALID = -1
FINISH
FINISH ELSE START
IF VS#0 THEN START
IF KN=1 AND WRAPPING#0 C
THEN RESPONSE = RESPONSE ! X'00000040'
KEY VALID = -1
FINISH
FINISH
IF KEY VALID#0 THEN START
VAL == ACTUAL (KN)
IF CSTART<=VAL_ADDRESS<CLIM C
THEN RESPONSE = RESPONSE ! X'00000020'
VAL_BOUND = VS ! X'18000000'
VAL_ADDRESS = VP
FINISH
KN = KN + 1
IF KN>TOTAL KEYS THEN START
KN = 1
WRAPPING = -1
FINISH
REPEAT
RETURN
!
!
END
!
!
END OF FILE