CONST INTEGER DIAGOP = 0; ! No diagnostic trace requested.
CONST INTEGER ULCEQUIV = -1
! Zero to make macro expansion distinguish upper and lower case in keywords,
! non-zero to make it treat upper and lower case as equivalent.
!
INCLUDE "SS0302S_SSOWNF"
!
RECORDFORMAT RF(INTEGER CONAD, FILETYPE, DATASTART, DATAEND)
! %RECORD %FORMAT PD (%INTEGER BOUND, ADDRESS)
! %RECORD %FORMAT SD (%INTEGER BOUND, ADDRESS, CURRENT OFFSET, CLASS, %C
! %INTEGER PARM COUNT, %STRING %ARRAY %NAME KWDN, %C
! %RECORD(PD) %ARRAY %NAME PARM VAL DET)
IF ULCEQUIV#0 THEN START
SYSTEM ROUTINE SPEC UCTRANSLATE (INTEGER A, L)
FINISH
SYSTEM ROUTINE SPEC MOVE (INTEGER LENGTH, FROM, TO)
SYSTEM INTEGER FN SPEC JOB READ CH
SYSTEM INTEGER FN SPEC JOB NEXT CH
SYSTEMROUTINESPEC CONNECT(STRING (31) FILE, C
INTEGER MODE, HOLE, PROT, RECORD (RF)NAME R, INTEGERNAME FLAG)
SYSTEM ROUTINE SPEC OUTFILE (STRING (31) NAME, C
INTEGER BYTES, HOLE, PROT, INTEGER NAME CONAD, FLAG)
!
IF DIAGOP#0 THEN START
EXTERNAL ROUTINE SPEC LIST PARAMETERS C
(INTEGER P, C
STRING ARRAY NAME KNAME, C
RECORD (PD) ARRAY NAME VALUE)
FINISH
!
! THE CLASS WORD IN THESE RECORDS IS LAID OUT AS FOLLOWS:
! BITS 4 TO 31: 1 FOR "DIRECT INPUT VIA READ CH",
! 2 FOR "DIRECT INPUT FROM AN AREA OF STORE",
! 3 FOR "INPUT THROUGH THE MACRO EXPANSION
! PROCESS FROM AN AREA OF STORE".
! BIT 0: (ONLY RELEVANT FOR CLASSES 2 AND 3, I.E., INPUT FROM AN
! AREA OF STORE, WITH OR WITHOUT MACRO EXPANSION): IF THIS
! BIT IS ZERO, THEN WHEN THE AREA IS EXHAUSTED, THE USER
! WILL GET NO NOTIFICATION FROM 'MASTER CHAR IN', AND INPUT
! WILL AUTOMATICALLY RESUME FROM WHERE IT LEFT OFF IN THE
! PREVIOUS LEVEL. IF THIS BIT IS NON-ZERO, THEN THE USER WILL
! BE GIVEN THE CHARACTER 25(DECIMAL), AND INPUT WILL NOT BE
! SWITCHED TO THE PREVIOUS LEVEL UNTIL THE USER CALLS 'ABANDON
! LEVEL'.
! BIT 3: ONLY RELEVANT FOR CLASS 2 (INPUT FROM AN AREA OF STORE WITHOUT
! MACRO EXPANSION) WITH BIT 0 NON-ZERO (REQUESTING EXPLICIT
! NOTIFICATION OF END-OF-AREA). IF THIS BIT IS ZERO, NO SPECIAL
! ACTION WILL BE TAKEN. IF IT IS NON-ZERO, THEN THE LAST
! CHARACTER IS GUARANTEED TO BE A NEWLINE. THAT IS,
! 'MASTER CHAR IN' WILL SUPPLY A NEWLINE BEFORE THE '25'
! CHARACTER, IF THERE IS NOT A NEWLINE IN THE LAST
! POSITION IN THE AREA. THIS PROVISION WILL NOT APPLY
! IF THE AREA IS EMPTY (I.E., OF LENGTH ZERO).
! BIT 2: RELEVANT FOR CLASSES 2 AND 3 (INPUT FROM AREAS OF STORE
! WITH OR WITHOUT MACRO EXPANSION). IF THIS IS NON-ZERO,
! THE AREA IS ASSUMED TO BE 'FIXED IN STORE'. THIS MEANS THAT,
! IN PASSING OUT A BYTE FROM THE AREA, 'MASTER CHAR IN' SHOULD
! SET 'IN CHAR ADDR' TO POINT TO THE BYTE. ANYONE WANTING
! TO 'REMEMBER' PARTS OF THE TEXT NEED ONLY KEEP POINTERS,
! AND NEED NOT COPY THE TEXT, SINCE IT SHOULD REMAIN IN
! THE SAME PLACE FOR THE DURATION OF THE 'JOB' OR 'SESSION'.
! IF THIS IS NOT TRUE - I.E., IF THE TEXT IS 'VOLATILE' (FOR
! INSTANCE, PARAMETER VALUES FOR MACROS) - THEN BIT 2 OF THE
! 'CLASS' WORD SHOULD BE ZERO.
! BIT 1: ONLY RELEVANT FOR CLASS 3 (MACRO EXPANSION). WHEN THE MACRO
! TEXT IS EXHAUSTED, THE 'BRACKET OPTION' WILL BE SET 'ON' IF
! THIS BIT IS NON-ZERO, AND 'OFF' IF IT IS ZERO. THAT IS, THIS
! BIT IS USED TO SAVE THE APPROPRIATE OPTION BEFORE IT IS
! ADJUSTED TO SUIT THE TEXT WITHIN THE MACRO, AND THE OPTION WILL
! REVERT PROPERLY ON 'EXIT' FROM THE MACRO.
!
! %OWN %INTEGER WSP BASE = 0, WSP LIM, WSP PTR
! %EXTERNAL %INTEGER IN SOURCE = 0
! %CONST %INTEGER SOURCE LEVELS = 15
! %OWN %RECORD(SD) %ARRAY SOURCE DETAIL (0:SOURCE LEVELS+1)
! ALLOW ONE EXTRA LEVEL FOR PARAMETER SUBSTITUTION IN A MACRO CALL
! BECAUSE IT ISN'T PRACTICAL TO CHECK THE LEVELS AT
! THE MOMENT OF MAKING THE SUBSTITUTION. ONE EXTRA LEVEL
! WILL ALWAYS BE SUFFICIENT.
! %OWN %INTEGER SCADDR, SHORT CUT = 0
CONST STRING (2) EXPANDER = "%%"
! %EXTRINSIC %INTEGER BRACKET FLAG
!
!
! THE VARIABLE 'IN CHAR ADDR' IS SET BY EVERY CALL OF 'MASTER CHAR IN'
! TO GIVE THE ADDRESS OF THE CHARACTER RETURNED. IF THE CHARACTER IS
! 'VOLATILE' - I.E., NOT CERTAIN TO CONTINUE TO EXIST AT ONE ADDRESS -
! THEN 'IN CHAR ADDR' WILL BE SET TO ZERO. THIS APPLIES TYPICALLY TO
! CHARACTERS READ FROM A CONSOLE, OR CHARACTERS GENERATED BY PARAMETER
! SUBSTITUTION IN A MACRO.
! %EXTERNAL %INTEGER IN CHAR ADDR
! %EXTERNAL %INTEGER LAST CHAR READ
!
!
! %EXTERNAL %INTEGER KWD MAX SIZE
CONST INTEGER KWD MAX = 11
! THIS IS THE MAXIMUM LENGTH ALLOWED FOR KEYWORD STRINGS.
! 'START MACROUTINES' COPIES IT INTO 'KWD MAX SIZE', SO THAT
! OTHER ROUTINES CAN CHECK IT. THE STRINGS IN 'KEY ARRAY DV'
! MUST BE OF THIS LENGTH.
! %OWN %STRING (11) %ARRAY %FORMAT KEY ARRAY DV (1:1000)
! %OWN %RECORD(PD) %ARRAY %FORMAT VAL DESC DV (1:1000)
CONST STRING (11) ARRAY FORMAT KEY ARRAY DV (1:1000)
CONST RECORD (PD) ARRAY FORMAT VAL DESC DV (1:1000)
! %EXTERNAL %INTEGER MAC INITIALISED = 0
!
SYSTEM ROUTINE NEW LEVEL C
(INTEGER BOUND, ADDRESS, EOFACT, INTEGER NAME R)
! 'ADDRESS' MUST HAVE THE ADDRESS OF THE FIRST BYTE OF AN AREA OF STORE.
! 'BOUND' MUST HAVE, IN ITS THREE LESS SIGNIFICANT BYTES, THE LENGTH OF
! THE AREA IN BYTES. THE VALUE OF THE MOST SIGNIFICANT BYTE OF 'BOUND'
! IS IMMATERIAL.
! THIS ROUTINE WILL SET UP THE AREA FOR INPUT VIA 'MASTER CHAR IN'.
! INPUT WILL BE BY DIRECT READING, NOT THROUGH THE MACRO EXPANSION
! PROCESS. IF THE AREA REPRESENTS A MACRO, DIRECT READING IS
! APPROPRIATE FOR PROCESSING THE MACRO HEADER, AND AFTER THE PARAMETER
! VALUES HAVE BEEN ESTABLISHED, A CALL OF 'USE AS MACRO' WILL MAKE THE
! NECESSARY ADJUSTMENTS TO ALLOW THE REST OF THE AREA TO BE READ VIA
! THE MACRO EXPANSION PROCESS.
! THE PARAMETER 'EOFACT' DETERMINES HOW END-OF-AREA WILL BE TREATED.
! IF EOFACT#0, THEN ANY ATTEMPT TO READ BEYOND THE END OF THE AREA WILL
! RETURN THE VALUE 25 (DECIMAL). IF EOFACT=0, THEN THE CALLER WILL
! RECEIVE NO INDICATION THAT END-OF-AREA HAS BEEN REACHED, AND INPUT
! WILL RESUME AT THE POINT IT HAD REACHED BEFORE 'NEW LEVEL' WAS CALLED.
! THUS EOFACT=0 WOULD BE APPROPRIATE IF THE NEW LEVEL REPRESENTS, FOR
! INSTANCE, A PARAMETER VALUE TO BE SUBSTITUTED IN EXPANDING A MACRO.
! EOFACT#0 WOULD BE SUITABLE IF THE AREA IS A FILE TO BE READ BY A USER
! PROGRAM. IF EOFACT=1, A SPECIAL PROVISION OPERATES WHEREBY, IF THE
! NEW LEVEL CONTAINS ANY TEXT AT ALL, THE LAST CHARACTER OF THE LEVEL IS
! GUARANTEED TO BE A NEWLINE. IF A NEWLINE IS NOT PRESENT IN THE TEXT,
! ONE WILL BE SUPPLIED BY 'MASTER CHAR IN' BEFORE THE CHARACTER 25.
! THE RESULT R=0 INDICATES SUCCESS, AND R#0 INDICATES FAILURE. THE ONLY
! FAILURE CONDITION IS 'TOO MANY INPUT LEVELS', GIVING R=X'80001000'.
RECORD (SD) NAME CURRENT IN DETAILS
IF SSOWN_IN SOURCE<SOURCE LEVELS THEN START
IF SSOWN_SHORT CUT#0 THEN START
CURRENT IN DETAILS == SSOWN_SOURCE DETAIL (SSOWN_IN SOURCE)
CURRENT IN DETAILS_CURRENT OFFSET = C
SSOWN_SCADDR - CURRENT IN DETAILS_ADDRESS
SSOWN_SHORT CUT = 0
FINISH
SSOWN_IN SOURCE = SSOWN_IN SOURCE + 1
CURRENT IN DETAILS == SSOWN_SOURCE DETAIL (SSOWN_IN SOURCE)
CURRENT IN DETAILS_BOUND = BOUND
CURRENT IN DETAILS_ADDRESS = ADDRESS
CURRENT IN DETAILS_CURRENT OFFSET = 0
IF EOFACT#0 THEN START
IF EOFACT=1 C
THEN EOFACT = X'90000000' C
ELSE EOFACT = X'80000000'
FINISH
CURRENT IN DETAILS_CLASS = EOFACT ! X'20000002'
R = 0
FINISH ELSE R = X'80001000'
END
!!
EXTERNAL ROUTINE RESET JCL (STRING (255) DUMMY)
SSOWN_MAC INITIALISED = 0
END
!
SYSTEM ROUTINE START MACROUTINES C
(INTEGER BOUND, ADDRESS, INTEGER NAME R)
INTEGER CONFLAG
RECORD (RF) RR
! THIS ROUTINE MUST BE CALLED EXACTLY ONCE BEFORE ANY OF THE OTHERS
! IN THIS SUITE. IT DEFINES THE PRIMARY INPUT STREAM FOR COMMANDS.
! IF THE INPUT STREAM IS TO BE AN AREA OF VIRTUAL STORE (E.G., A FILE
! OR PART OF A FILE, OR A STRING), THEN 'BOUND' MUST HAVE THE SIZE OF
! THE AREA IN BYTES, AND 'ADDRESS' MUST HAVE THE ADDRESS OF THE FIRST
! BYTE OF THE AREA. IF THE INPUT STREAM IS TO BE FROM A TERMINAL, THEN
! 'BOUND' MUST BE ZERO AND THE VALUE OF 'ADDRESS' IS IMMATERIAL. IN
! EITHER CASE, 'BOUND' IS ALWAYS TREATED AS IF ITS MOST SIGNIFICANT
! BYTE WERE ZERO, REGARDLESS OF ITS ACTUAL VALUE. THIS ALLOWS THE
! BOUND WORD OF A DESCRIPTOR TO BE USED.
R = 0
IF SSOWN_MAC INITIALISED#0 THEN START
IF ADDRESS#0 THEN NEW LEVEL (BOUND,ADDRESS,1,R)
FINISH ELSE START
SSOWN_KWD MAX SIZE = KWD MAX
SSOWN_LAST CHAR READ = NL
IF SSOWN_WSP BASE=0 THEN START
SSOWN_WSP LIM = 8192
CONNECT("T#MACSTACK",3,0,0,RR,CONFLAG)
IF CONFLAG = 0 START
SSOWN_WSP BASE = RR_CONAD
ELSE
OUTFILE ("T#MACSTACK",SSOWN_WSP LIM,0,8,SSOWN_WSP BASE,CONFLAG)
FINISH
SSOWN_WSP LIM = SSOWN_WSP BASE + SSOWN_WSP LIM
SSOWN_WSP PTR = SSOWN_WSP BASE
FINISH
SSOWN_IN SOURCE = 0
SSOWN_SOURCE DETAIL(0)_CURRENT OFFSET = 0
IF BOUND&X'00FFFFFF'=0 THEN START
SSOWN_SOURCE DETAIL(0)_CLASS = X'90000001'
FINISH ELSE START
SSOWN_SOURCE DETAIL(0)_CLASS = X'B0000002'
SSOWN_SOURCE DETAIL(0)_BOUND = BOUND
SSOWN_SOURCE DETAIL(0)_ADDRESS = ADDRESS
FINISH
SSOWN_MAC INITIALISED = -1
FINISH
SSOWN_SHORT CUT = 0
END
!
!
SYSTEM ROUTINE MACOPEN
!
! THIS IS A CUT-DOWN VERSION OF 'START MACROUTINES' TO BE USED
! WHEN THE MACRO ROUTINES ARE ONLY TO BE USED FOR EXAMINING THE
! HEADER LINE OF A MACRO.
!
IF SSOWN_MAC INITIALISED=0 THEN START
SSOWN_WSP LIM = 0
SSOWN_WSP PTR = 0
SSOWN_WSP BASE = 0
SSOWN_IN SOURCE = 0
SSOWN_SOURCE DETAIL(0)_CLASS = X'B0000002'
SSOWN_SOURCE DETAIL(0)_BOUND = 0
SSOWN_SOURCE DETAIL(0)_ADDRESS = 0
SSOWN_SOURCE DETAIL(0)_CURRENT OFFSET = 0
SSOWN_SHORT CUT = 0
FINISH
END
!
!
SYSTEM ROUTINE USE AS MACRO (INTEGER NPARM, C
STRING ARRAY NAME KEYWORDS, C
RECORD (PD) ARRAY NAME ACTUAL PARMS, C
INTEGER BFLAG, INTEGER NAME FAILURE)
! IF AN AREA HAS BEEN SET UP FOR 'DIRECT INPUT' (BY 'NEW LEVEL'), THEN
! THIS ROUTINE WILL ADJUST THE TABLES SO THAT THE REMAINDER OF THE AREA
! - I.E., ANY WHICH HAS NOT YET BEEN READ - WILL BE READ VIA THE MACRO
! EXPANSION PROCEDURE. ON "EXIT" FROM THE MACRO, INPUT WILL REVERT
! TO THE NEXT OUTER LEVEL WITHOUT ANY NOTIFICATION TO THE USER OF
! 'MASTER CHAR IN'. WHEN INPUT REVERTS, THE "BRACKETS" OPTION WILL BE
! SET ACCORDING TO THE VALUE OF 'BFLAG' SUPLIED IN THE CALL ON
! 'USE AS MACRO'. THUS WHEN YOU CALL 'USE AS MACRO', YOU SHOULD PASS IN
! YOUR CURRENT VALUE OF THE "BRACKET" FLAG, AND AFTER THAT YOU MAY
! CHANGE THE FLAG TO SUIT THE TEXT INSIDE THE MACRO.
! THE ONLY ERROR CONDITION REPORTED BY THIS ROUTINE IS
! 'TOO LITTLE SPACE IN THE MACRO WORK AREA', WHICH GIVES
! FAILURE = X'80000400'. OTHERWISE FAILURE WILL BE ZERO ON EXIT.
!
INTEGER I, J, OLD PTR
! %INTEGER K, M; ! **** NOT NEEDED IF WE USE 'MOVE' ****
INTEGER KTLIM, MOVE SIZE, MOVE DEST; ! **** NEEDED ****
! **** ONLY IF WE ARE USING 'MOVE' - SEE BELOW. ****
RECORD (PD) NAME COPY SOURCE DR
RECORD (PD) ARRAY NAME PV COPY
RECORD (SD) NAME CURRENT IN DETAILS
INTEGER NAME OFFSET
FAILURE = 0
IF BFLAG#0 THEN BFLAG = X'40000000'
CURRENT IN DETAILS == SSOWN_SOURCE DETAIL (SSOWN_IN SOURCE)
CURRENT IN DETAILS_CLASS = BFLAG ! X'20000003'
OFFSET == CURRENT IN DETAILS_CURRENT OFFSET
IF SSOWN_SHORT CUT#0 THEN START
CURRENT IN DETAILS_BOUND = C
CURRENT IN DETAILS_BOUND - SSOWN_SCADDR + CURRENT IN DETAILS_ADDRESS
CURRENT IN DETAILS_ADDRESS = SSOWN_SCADDR
SSOWN_SHORT CUT = 0
FINISH ELSE START
CURRENT IN DETAILS_BOUND = CURRENT IN DETAILS_BOUND - OFFSET
CURRENT IN DETAILS_ADDRESS = CURRENT IN DETAILS_ADDRESS + OFFSET
FINISH
OFFSET = 0
CURRENT IN DETAILS_PARM COUNT = NPARM
OLD PTR = SSOWN_WSP PTR
SSOWN_WSP PTR = (SSOWN_WSP PTR+7) & (-8)
IF NPARM>0 THEN START
BEGIN
STRING ARRAY NAME KTABLE
RECORD (PD) NAME COPY DEST DR
CURRENT IN DETAILS_PARM VAL DET == ARRAY (SSOWN_WSP PTR,VAL DESC DV)
PV COPY == ARRAY (SSOWN_WSP PTR,VAL DESC DV)
SSOWN_WSP PTR = ADDR (PV COPY(NPARM+1))
IF SSOWN_WSP PTR>SSOWN_WSP LIM THEN -> TOO BIG
FOR I=1,1,NPARM CYCLE
COPY SOURCE DR == ACTUAL PARMS (I)
COPY DEST DR == PV COPY (I)
J = COPY SOURCE DR_BOUND
COPY DEST DR_BOUND = J
COPY DEST DR_ADDRESS = SSOWN_WSP PTR
J = J & X'00FFFFFF'
IF SSOWN_WSP PTR+J>SSOWN_WSP LIM THEN -> TOO BIG
IF J>0 THEN START
! **** **** REPLACE BY MACHINE CODE: **** ****
! M = COPY SOURCE DR_ADDRESS
! %FOR K=0,1,J-1 %CYCLE
! BYTE INTEGER (SSOWN_WSP PTR+K) = BYTE INTEGER (M+K)
! %REPEAT
! EQUIVALENT TO:
MOVE (J, COPY SOURCE DR_ADDRESS, SSOWN_WSP PTR)
! **** **** END OF MACHINE CODE SECTION **** ****
SSOWN_WSP PTR = SSOWN_WSP PTR + J
FINISH
REPEAT
SSOWN_WSP PTR = (SSOWN_WSP PTR + 7) & (-8)
CURRENT IN DETAILS_KWDN == ARRAY (SSOWN_WSP PTR,KEY ARRAY DV)
KTABLE == ARRAY (SSOWN_WSP PTR,KEY ARRAY DV)
! **** **** THIS IS ONLY NEEDED IF WE USE 'MOVE' **** ****
KTLIM = ADDR (KTABLE(NPARM+1))
MOVE SIZE = KTLIM - SSOWN_WSP PTR
MOVE DEST = SSOWN_WSP PTR
SSOWN_WSP PTR = (KTLIM + 7) & (-8) + 4; ! ROUNDED UP.
! **** **** THE FOLLOWING LINE IS THE ALTERNATIVE **** ****
! **** **** NEEDED IF WE DO THE MOVE IN A %CYCLE **** ****
! SSOWN_WSP PTR = (ADDR(KTABLE(NPARM+1))+7) & (-8) + 4; ! ROUNDED UP.
! **** **** END OF ALTERNATIVE **** ****
IF SSOWN_WSP PTR>SSOWN_WSP LIM THEN -> TOO BIG
! **** **** REPLACE BY MACHINE CODE: **** ****
! %FOR I=1,1,NPARM %CYCLE
! KTABLE (I) = KEYWORDS (I)
! %REPEAT
! EQUIVALENT TO:
MOVE (MOVE SIZE, ADDR(KEYWORDS(1)), MOVE DEST)
! **** **** END OF MACHINE CODE SECTION **** ****
!
IF DIAGOP#0 THEN LIST PARAMETERS (NPARM,KTABLE,PV COPY)
!
TOO BIG:
END
FINISH ELSE SSOWN_WSP PTR = SSOWN_WSP PTR + 4
IF SSOWN_WSP PTR<=SSOWN_WSP LIM THEN START
INTEGER (SSOWN_WSP PTR-4) = OLD PTR
RETURN
FINISH ELSE START
SSOWN_WSP PTR = OLD PTR
SSOWN_IN SOURCE = SSOWN_IN SOURCE - 1
FAILURE = FAILURE ! X'80000400'
RETURN
FINISH
END
!
!
SYSTEM ROUTINE CLEAR LEVEL (INTEGER L)
IF L>0 THEN SSOWN_IN SOURCE = L - 1 ELSE SSOWN_MAC INITIALISED = 0
SSOWN_SHORT CUT = 0
END
!
!
SYSTEM ROUTINE ABANDON LEVEL
IF SSOWN_IN SOURCE>0 C
THEN SSOWN_IN SOURCE = SSOWN_IN SOURCE - 1 C
ELSE SSOWN_MAC INITIALISED = 0
SSOWN_SHORT CUT = 0
END
!
!
SYSTEM ROUTINE RESTART THIS LEVEL
SSOWN_SOURCE DETAIL(SSOWN_IN SOURCE)_CURRENT OFFSET = 0
SSOWN_SHORT CUT = 0
END
!
!
SYSTEM ROUTINE GO BACK
! THIS IS FOR 'BACKWARD .GOTO'S. IT NEEDS TO FIND THE HIGHEST CURRENT
! INPUT LEVEL EXCLUDING IMPERMANENT THINGS LIKE PARAMETER VALUES, SO IT
! LOOKS DOWN THROUGH THE LEVELS FOR A MACRO TEXT OR PERMANENT TEXT.
INTEGER S, C, F
RECORD (SD) NAME IN DETAILS
S = SSOWN_IN SOURCE
F = -1
WHILE S>F CYCLE
IN DETAILS == SSOWN_SOURCE DETAIL (S)
C = IN DETAILS_CLASS & X'27FFFFFF'
IF C=X'20000002' OR C&X'07FFFFFF'=3 THEN F = S
S = S - 1
REPEAT
IF F>=0 THEN START
IN DETAILS_CURRENT OFFSET = 0
SSOWN_SHORT CUT = 0
FINISH
END
!
!
SYSTEM INTEGER FN MASTER CHAR IN (INTEGER CONTROL)
! 'MASTER CHAR IN' IS A SUBSTITUTE FOR 'READ CH' AND 'NEXT CH'.
! YOU USE
! S = MASTER CHAR IN (1)
! INSTEAD OF
! READ CH (S)
! AND
! S = MASTER CHAR IN (0)
! INSTEAD OF
! S = NEXT CH
! IF YOU WANT TO FORCE INPUT TO COME FROM THE "OUTERMOST LEVEL",
! THEN USE -1 FOR "READ CH", AND -2 FOR "NEXT CH".
! THIS ROUTINE TAKES CARE OF MACRO EXPANSION AND SO ON. THE
! COMMENTS ON 'NEW LEVEL', 'USE AS MACRO', ETC., EXPLAIN HOW
! TO SPECIFY WHERE INPUT SHOULD COME FROM, AND HOW END-OF-INPUT
! IS TREATED.
STRING (8) ARRAY NAME KWD NAME
RECORD (PD) ARRAY NAME PARM SPEC
! %OWN %INTEGER LIM, SCLIM, PERMANENCE, SLVL
! %OWN %INTEGER %NAME OFFSET
INTEGER CLASS WORD, ENDACT, ENDNL, CLASS NUMBER, D
INTEGER LOOP LIM, ADVANCE
! %OWN %RECORD(SD) %NAME CURRENT IN DETAILS
RECORD (PD) NAME PARM DETAILS
IF ULCEQUIV=0 THEN START
STRING NAME KWDSTR
FINISH ELSE START
STRING (11) KWDSTR, CHECKWDSTR; ! Max length must be =KWD MAX
FINISH
SWITCH HANDLE (1:3)
INTEGER M, I, L, J, NUMBER OF PARAMS, BYTES TO TEST
!
ADVANCE = CONTROL & 1
!
IF SSOWN_SHORT CUT#0 THEN START
IF CONTROL>=0 OR SSOWN_SLVL=0 THEN START
D = BYTE INTEGER (SSOWN_SCADDR)
IF D=25 THEN START
SSOWN_OFFSET = SSOWN_LIM
FINISH ELSE START
IF SSOWN_PERMANENCE=0 C
THEN SSOWN_IN CHAR ADDR = 0 C
ELSE SSOWN_IN CHAR ADDR = SSOWN_SCADDR
IF ADVANCE#0 THEN START
SSOWN_LAST CHAR READ = D
SSOWN_SCADDR = SSOWN_SCADDR + 1
IF SSOWN_SCADDR>=SSOWN_SCLIM THEN START
SSOWN_OFFSET = SSOWN_LIM
SSOWN_SHORT CUT = 0
FINISH
FINISH
RESULT = D
FINISH
FINISH ELSE START
SSOWN_OFFSET = SSOWN_SCADDR - SSOWN_CURRENT IN DETAILS_ADDRESS
FINISH
FINISH
SSOWN_SHORT CUT = 0
!
! THIS ROUTINE IS AN ENDLESS CYCLE, FROM WHICH THE ONLY
! ESCAPE IS BY %RESULT = SOMETHING. WITHIN THE CYCLE, CONTROL
! IS SWITCHED TO ONE OF THREE POINTS DEPENDING ON THE NATURE
! OF THE PROCESSING APPROPRIATE TO THE CURRENT INPUT LEVEL.
! THE ONLY 'GOTO' IS AT THE END OF EACH PROCESSING SECTION TO
! GET TO THE BOTTOM OF THE LOOP.
CYCLE
!
IF CONTROL<0 THEN SSOWN_SLVL = 0 ELSE SSOWN_SLVL = SSOWN_IN SOURCE
SSOWN_CURRENT IN DETAILS == SSOWN_SOURCE DETAIL (SSOWN_SLVL)
CLASS WORD = SSOWN_CURRENT IN DETAILS_CLASS
ENDACT = CLASS WORD & X'80000000'
ENDNL = CLASS WORD & X'10000000'
SSOWN_PERMANENCE = CLASS WORD & X'20000000'
CLASS NUMBER = CLASS WORD & X'07FFFFFF'
-> HANDLE (CLASS NUMBER)
!
HANDLE (1): ! INPUT FROM CONTROL STREAM -
! IF THERE IS ANY POSSIBILITY THAT 'READ CH' AND 'NEXT CH' WOULD
! BE USED ON SOME FILE OTHER THAN A CONSOLE INPUT STREAM, THE FOLLOWING
! CODE SHOULD BE MODIFIED TO MAKE SURE THAT %EVENT 9 COULD NEVER BE
! CAUSED, SINCE THE CODE IS NOT PROTECTED AGAINST THAT CONTINGENCY.
! THE WAY TO DO IT IS TO DECLARE
! %OWN %INTEGER DREAD=0
! AT THE HEAD OF THIS ROUTINE, AND THEN REPLACE THE CODE BELOW (FROM
! %IF ADVANCE... TO %RESULT = D) BY:
! %IF DREAD#25 %THEN %START
! %IF ADVANCE=0 %THEN DREAD = JOB NEXT CH %ELSE %START
! DREAD = JOB READ CH
! SSOWN_LAST CHAR READ = DREAD
! %FINISH
! %FINISH
! %RESULT = DREAD
!
SSOWN_IN CHAR ADDR = 0
IF ADVANCE=0 THEN D = JOB NEXT CH ELSE START
D = JOB READ CH
SSOWN_LAST CHAR READ = D
FINISH
RESULT = D
!
HANDLE (2): ! INPUT FROM A FILE OR STRING -
SSOWN_OFFSET == SSOWN_CURRENT IN DETAILS_CURRENT OFFSET
SSOWN_LIM = SSOWN_CURRENT IN DETAILS_BOUND & X'00FFFFFF'
IF SSOWN_OFFSET>=SSOWN_LIM THEN START
IF ENDACT#0 THEN START
SSOWN_IN CHAR ADDR = 0
IF ADVANCE#0 THEN SSOWN_LAST CHAR READ = NL
IF ENDNL#0 AND SSOWN_OFFSET=SSOWN_LIM AND SSOWN_LIM>0 C
AND BYTE INTEGER(SSOWN_CURRENT IN DETAILS_ADDRESS+SSOWN_LIM-1)#NL C
THEN START
SSOWN_OFFSET = SSOWN_OFFSET + ADVANCE
RESULT = NL
FINISH
RESULT = 25
FINISH
SSOWN_IN SOURCE = SSOWN_IN SOURCE - 1
FINISH ELSE START
SSOWN_IN CHAR ADDR = SSOWN_CURRENT IN DETAILS_ADDRESS+SSOWN_OFFSET
D = BYTE INTEGER (SSOWN_IN CHAR ADDR)
IF D=25 THEN START
SSOWN_OFFSET = SSOWN_LIM
FINISH ELSE START
SSOWN_OFFSET = SSOWN_OFFSET + ADVANCE
IF SSOWN_OFFSET<SSOWN_LIM THEN START
SSOWN_SHORT CUT = -1
SSOWN_SCADDR = SSOWN_IN CHAR ADDR + ADVANCE
SSOWN_SCLIM = SSOWN_CURRENT IN DETAILS_ADDRESS + SSOWN_LIM
FINISH
IF SSOWN_PERMANENCE=0 THEN SSOWN_IN CHAR ADDR = 0
IF ADVANCE#0 THEN SSOWN_LAST CHAR READ = D
RESULT = D
FINISH
FINISH
-> LOOP END
!
HANDLE (3): ! INPUT FROM A MACRO EXPANSION -
KWD NAME == SSOWN_CURRENT IN DETAILS_KWDN
PARM SPEC == SSOWN_CURRENT IN DETAILS_PARM VAL DET
NUMBER OF PARAMS = SSOWN_CURRENT IN DETAILS_PARM COUNT
SSOWN_OFFSET == SSOWN_CURRENT IN DETAILS_CURRENT OFFSET
SSOWN_LIM = SSOWN_CURRENT IN DETAILS_BOUND & X'00FFFFFF'
IF SSOWN_OFFSET>=SSOWN_LIM THEN START
SSOWN_BRACKET FLAG = CLASS WORD&X'40000000'
IF ENDACT#0 THEN START
SSOWN_IN CHAR ADDR = 0
IF ADVANCE#0 THEN SSOWN_LAST CHAR READ = NL
RESULT = 25
FINISH
SSOWN_WSP PTR = INTEGER (SSOWN_WSP PTR-4)
SSOWN_IN SOURCE = SSOWN_IN SOURCE - 1
FINISH ELSE START
SSOWN_IN CHAR ADDR = SSOWN_CURRENT IN DETAILS_ADDRESS + SSOWN_OFFSET
BYTES TO TEST = SSOWN_LIM - SSOWN_OFFSET
IF BYTES TO TEST>KWD MAX+LENGTH(EXPANDER) C
THEN BYTES TO TEST = KWD MAX + LENGTH(EXPANDER)
D = BYTE INTEGER (SSOWN_IN CHAR ADDR)
IF D=25 THEN START
SSOWN_OFFSET = SSOWN_LIM
FINISH ELSE START
LOOP LIM = NUMBER OF PARAMS
! **** **** THIS TEST WOULD NEED TO BE EXPANDED IF **** ****
! **** **** LENGTH(EXPANDER)>2 **** ****
IF D=BYTE INTEGER(ADDR(EXPANDER)+1) C
AND NUMBER OF PARAMS>=1 C
AND BYTES TO TEST>=LENGTH(EXPANDER)+1 C
AND BYTE INTEGER(SSOWN_IN CHAR ADDR+1) C
=BYTE INTEGER(ADDR(EXPANDER)+2) C
THEN START
M = BYTES TO TEST - 2
I = 1
WHILE I<=LOOP LIM CYCLE
IF ULCEQUIV=0 THEN START
KWDSTR == KWD NAME (I)
FINISH ELSE START
KWDSTR = KWD NAME (I)
FINISH
L = LENGTH (KWDSTR); ! MUST NEVER BE LESS THAN 1.
IF M>=L THEN START
IF ULCEQUIV=0 THEN START
! **** **** REPLACE BY MACHINE CODE **** ****
J = 1
WHILE J<=L C
AND BYTE INTEGER(ADDR(KWDSTR)+J) C
=BYTE INTEGER(SSOWN_IN CHAR ADDR+J+1) C
CYCLE
J = J + 1
REPEAT
! **** **** END OF MACHINE CODE SECTION **** ****
IF J>L THEN START
SSOWN_OFFSET = SSOWN_OFFSET + L + 2
PARM DETAILS == PARM SPEC (I)
SSOWN_IN SOURCE = SSOWN_IN SOURCE + 1
SSOWN_CURRENT IN DETAILS == SSOWN_SOURCE DETAIL (SSOWN_IN SOURCE)
SSOWN_CURRENT IN DETAILS_BOUND = PARM DETAILS_BOUND
SSOWN_CURRENT IN DETAILS_ADDRESS = C
PARM DETAILS_ADDRESS
SSOWN_CURRENT IN DETAILS_CURRENT OFFSET = 0
SSOWN_CURRENT IN DETAILS_CLASS = 2
LOOP LIM = -1; ! TO FORCE EXIT.
FINISH
FINISH ELSE START
UCTRANSLATE (ADDR(KWDSTR)+1,L)
MOVE (L, SSOWN_IN CHAR ADDR + 2, ADDR(CHECKWDSTR) + 1)
UCTRANSLATE (ADDR(CHECKWDSTR)+1, L)
LENGTH (CHECKWDSTR) = L
IF CHECKWDSTR=KWDSTR THEN START
SSOWN_OFFSET = SSOWN_OFFSET + L + 2
PARM DETAILS == PARM SPEC (I)
SSOWN_IN SOURCE = SSOWN_IN SOURCE + 1
SSOWN_CURRENT IN DETAILS == SSOWN_SOURCE DETAIL (SSOWN_IN SOURCE)
SSOWN_CURRENT IN DETAILS_BOUND = PARM DETAILS_BOUND
SSOWN_CURRENT IN DETAILS_ADDRESS = C
PARM DETAILS_ADDRESS
SSOWN_CURRENT IN DETAILS_CURRENT OFFSET = 0
SSOWN_CURRENT IN DETAILS_CLASS = 2
LOOP LIM = -1; ! TO FORCE EXIT.
FINISH
FINISH
FINISH
I = I + 1
REPEAT
FINISH
IF LOOP LIM>=0 THEN START
IF SSOWN_PERMANENCE=0 THEN SSOWN_IN CHAR ADDR = 0
SSOWN_OFFSET = SSOWN_OFFSET + ADVANCE
IF ADVANCE#0 THEN SSOWN_LAST CHAR READ = D
RESULT = D
FINISH
FINISH
FINISH
!
LOOP END:
REPEAT
! THIS IS THE END OF THE MAIN LOOP OF THIS ROUTINE.
!
END
!
!
IF DIAGOP#0 THEN START
EXTERNAL ROUTINE PRINT LEVELS
RECORD (SD) NAME CURRENT IN DETAILS
INTEGER LEVEL, CLASS WORD, CLASS NUMBER, ENDACT, PERMANENCE
INTEGER REVERSION
PRINT STRING ("INPUT MAP:".TOSTRING(NL))
FOR LEVEL=SSOWN_IN SOURCE,-1,0 CYCLE
PRINT STRING ("LEVEL")
PRINT (LEVEL,3,0)
CURRENT IN DETAILS == SSOWN_SOURCE DETAIL (LEVEL)
CLASS WORD = CURRENT IN DETAILS_CLASS
ENDACT = CLASS WORD & X'80000000'
REVERSION = CLASS WORD & X'40000000'
PERMANENCE = CLASS WORD & X'20000000'
CLASS NUMBER = CLASS WORD & X'07FFFFFF'
IF CLASS NUMBER = 1 THEN START
PRINT STRING (": DIRECT INPUT".TOSTRING(NL))
FINISH ELSE START
IF CLASS NUMBER = 2 THEN START
PRINT STRING (": TEXT, AT ")
FINISH ELSE START
PRINT STRING (": MACRO, AT ")
FINISH
PRINT (CURRENT IN DETAILS_ADDRESS,12,0)
PRINT STRING (" LENGTH ")
PRINT (CURRENT IN DETAILS_BOUND&X'00FFFFFF',9,0)
NEWLINE
FINISH
REPEAT
END
FINISH
!
!
SYSTEM INTEGER FN LAST CHAR COPY
RESULT = SSOWN_LAST CHAR READ
END
!
!
END OF FILE