!!
!**********************************************************************
!*
!* THESE ROUTINES SET UP, LIST AND AMEND A SET OF DEFAULT OPTIONS
!* FOR THE SCIENTIFIC JOBBER ON EMAS 2900.
!*
!**********************************************************************
!*
!*
SYSTEMROUTINESPEC CONNECT(STRING (15) S, C
INTEGER ACCESS, MAXBYTES, PROTECTION, C
RECORDNAME R, INTEGERNAME FLAG)
CONSTSTRING (11) FILE = "JDEFAULTS"
EXTERNALSTRINGFNSPEC UINFS(INTEGER ENTRY)
EXTERNALINTEGERFNSPEC DPERMISSION( C
STRING (6) OWNER, USER, STRING (8) DATE, C
STRING (11) FILE, INTEGER FSYS, TYPE, ADRPRM)
EXTERNALINTEGERFNSPEC DCREATE(STRING (6) USER, C
STRING (11) FILE, INTEGER FSYS, NKB, TYPE)
!!
RECORDFORMAT INFM(INTEGER CONAD, FILESIZE, C
BYTEINTEGER DUM1, DUM2, DUM3, DUM4, C
STRING (6) DUM5, INTEGER TYPEDUM6, C
INTEGER DATASTART, DATAEND, DUM7)
RECORDFORMAT OPTFM(INTEGER FACLEVEL, MDEFAULT, MMAX, LDEFAULT, C
LMAX, FMAX, BREAK, OPTIONS)
!!
ROUTINE SJDERROR(STRING (16) ACTION, INTEGER FLAG)
PRINTSTRING("
".ACTION." JDEFAULTS FAILED, FLAG = ")
WRITE(FLAG,8)
STOP
END
!!
CONSTSTRING (9) ARRAY PARMS(0 : 29) = C
'QUOTES','NOLIST','NODIAG','STACK',
'NOCHECK','NOARRAY','NOTRACE','SMAP',
'NORUN','INHIBIOF','ZERO','XREF',
'LABELS','LET','CODE','ATTR',
'OPT','INHIBOPEH','####','FREE',
'####','####','EBCDIC','NOLINE',
'####','MAXKEYS','I8','L8',
'R8','MISMATCH'
!*
CONSTSTRING (10) ARRAY ALTPARMS(0 : 29) = C
C
'PERCENT','LIST','DIAG','NOSTACK',
'CHECK','ARRAY','TRACE','####',
'RUN','####','####','NOXREF',
'NOLABELS','NOLET','NOCODE','NOATTR',
'####','####','####','FIXED',
'####','####','ISO','LINE',
'####','MINKEYS','I4','L4',
'R4','NOMISMATCH'
!*
!*
ROUTINESPEC PRINT OPTIONS(INTEGER N)
!*
INTEGERFN PARM(STRING (63) S, INTEGER OLDPARM)
STRING (63) T
INTEGER I, J, K
I = OLDPARM
L1: IF S = '' THEN RESULT = I
UNLESS S -> T.(",").S THEN START
UNLESS S -> T.("&").S THEN START
T = S
S = ''
FINISH
FINISH
CYCLE J = 0,1,29
IF PARMS(J) = T THEN START
I = I!(1<<J)
-> L1
FINISH
IF ALTPARMS(J) = T THEN START
K = (-1)!!(1<<J)
I = I&K
-> L1
FINISH
REPEAT
PRINTSTRING('***INVALID OPTION '.T.' IGNORED
')
-> L1
END ; !OF PARM
!*
ROUTINE PRINT OPTIONS(INTEGER J)
INTEGER I, K, L, M
CONSTBYTEINTEGERARRAY INDEX(0 : 17) = C
1, 4, 5,23, 2,16, 6,12,15,11,14, 0,22,28,26,27, 9,29
CONSTBYTEINTEGERARRAY MASK(0 : 17) = C
7,14, 7, 7, 7,21, 1, 4, 4, 4,20, 3, 8, 4, 4, 4,20, 4
ROUTINESPEC P(STRING (15) S)
PRINTSTRING('
COMPILATION OPTIONS: ')
K = 0
CYCLE I = 0,1,17
M = MASK(I)
L = INDEX(I)
IF J&(1<<L) = 0 THEN START
IF M&2 # 0 OR M&16 = 0 THEN P(ALTPARMS(L))
FINISH ELSE START
IF M&1 # 0 OR M&16 = 0 THEN P(PARMS(L))
FINISH
REPEAT
IF K = 0 THEN PRINTSTRING('DEFAULTS')
NEWLINES(2)
RETURN
!*
ROUTINE P(STRING (15) S)
IF K # 0 THEN PRINTSYMBOL(',')
PRINTSTRING(S)
K = K+1
END ; ! P
END ; ! PRINT OPTIONS
!!
!!**********************************************************************!!
!! PRINT OUT CURRENT OPTIONS FOR JOBBER PROCESS('S)
!!
!!********************************************************************
EXTERNALROUTINE PRINTJOPTIONS(STRING (63) JOBBERS)
RECORD IN(INFM)
RECORDNAME JOPT(OPTFM)
STRING (6) USER, JOBBER
INTEGER FLAG, FSYS
!!
USER = UINFS(1)
CYCLE
UNLESS JOBBERS -> JOBBER.(",").JOBBERS C
THEN JOBBER = JOBBERS AND JOBBERS = ""
FSYS = -1
FLAG = DPERMISSION(JOBBER,USER,"",FILE,FSYS,1,1)
IF FLAG # 0 THEN SJDERROR("DPERMIT",FLAG)
CONNECT(JOBBER.".".FILE,0,0,0,IN,FLAG)
IF FLAG # 0 THEN SJDERROR("CONNECT",FLAG)
JOPT == RECORD(IN_CONAD+32)
PRINTSTRING("
".JOBBER. C
" - OPTIONS CURRENTLY IN FORCE ARE:
FACILITY LEVEL = ")
WRITE(JOPT_FACLEVEL,8)
PRINTSTRING("
CPULIMITS - DEFAULT = ")
WRITE(JOPT_MDEFAULT,8)
PRINTSTRING(" SECS MAXIMUM = ")
WRITE(JOPT_MMAX,7)
PRINTSTRING(" SECS
OUTPUT LIMIT - DEFAULT = ")
WRITE(JOPT_LDEFAULT,8)
PRINTSTRING(" LINES MAXIMUM = ")
WRITE(JOPT_LMAX,7)
PRINTSTRING(" LINES
MAX. FILE SIZE = ")
WRITE(JOPT_FMAX//1024,8)
PRINTSTRING(" KBYTES
OUTPUT BREAK LIMIT = ")
WRITE(JOPT_BREAK,8)
PRINTSTRING(" LINES
")
PRINT OPTIONS(JOPT_OPTIONS)
EXIT IF JOBBERS = ""
REPEAT
END ; ! OF PRINT J OPTIONS
!!
!!**********************************************************************!!
!! CREATE JOBBER OPTIONS FILE AND SET UP DEFAULT VALUES.
!!
!!**********************************************************************
EXTERNALROUTINE CREATE J OPTIONS(STRING (63) JOBBERS)
RECORD IN(INFM)
STRING (6) USER, JOBBER
INTEGER CONAD, FLAG, FSYS
RECORDNAME JOPT(OPTFM)
!!
USER = UINFS(1)
CYCLE
UNLESS JOBBERS -> JOBBER.(",").JOBBERS C
THEN JOBBER = JOBBERS AND JOBBERS = ""
FSYS = -1
FLAG = DCREATE(JOBBER,FILE,FSYS,4,8); ! 8=CHERISH
IF FLAG # 0 AND FLAG # 16 C
THEN SJDERROR("DCREATE",FLAG)
! 16=ALREADY EXISTS
FLAG = DPERMISSION(JOBBER,USER,"",FILE,FSYS,1,3)
IF FLAG # 0 THEN SJDERROR("DPERMIT",FLAG)
CONNECT(JOBBER.".".FILE,3,0,0,IN,FLAG)
IF FLAG # 0 THEN SJDERROR("CONNECT",FLAG)
CONAD = IN_CONAD
JOPT == RECORD(CONAD+32)
INTEGER(CONAD) = 64
INTEGER(CONAD+8) = X'4000'
JOPT = 0
JOPT_FACLEVEL = 2
JOPT_MDEFAULT = 30
JOPT_MMAX = 300
JOPT_LDEFAULT = 1000
JOPT_LMAX = 5000
JOPT_FMAX = X'40000'; ! 8 SEGS
JOPT_BREAK = 5000
JOPT_OPTIONS = X'81000001'; ! STACK LIMIT DEFINED,ISO,QUOTES
EXIT IF JOBBERS = ""
REPEAT
END
!!
ROUTINE READLINE(STRING (255) NAME LINE)
WHILE NEXTSYMBOL = NL THEN SKIPSYMBOL; ! SKIP BLANK LINES
LINE = ""
WHILE NEXTSYMBOL # NL THEN CYCLE
WHILE NEXTSYMBOL = ' ' THEN SKIPSYMBOL
LENGTH(LINE) = LENGTH(LINE)+1
BYTEINTEGER(ADDR(LINE)+LENGTH(LINE)) = NEXTSYMBOL
SKIPSYMBOL
REPEAT
SKIPSYMBOL
END
!!
INTEGERFN STOI(STRING (8) S, INTEGERNAME N)
INTEGER I, J
N = 0
I = 1
CYCLE
J = BYTEINTEGER(ADDR(S)+I)
UNLESS '0' <= J <= '9' THEN RESULT = 2
N = (N*10)+(J-'0')
EXIT IF I >= LENGTH(S)
I = I+1
REPEAT
RESULT = 0
END
!!
!!***********************************************************************!!
!!
!! AMEND JOBBER OPTIONS
!!
!!**********************************************************************
EXTERNALROUTINE SET J OPTIONS(STRING (63) JOBBERS)
RECORDNAME JOPT(OPTFM)
RECORD IN(INFM)
STRING (63) LJOBBERS
STRING (6) USER, JOBBER
INTEGER FLAG, I, NJ, N, FSYS, CT
SWITCH NJS(1 : 7)
STRING (128) S, REST, OPT
CONSTSTRING (8) ARRAY OPTS(1 : 8) = C
C
"FACLEVEL","MDEFAULT","MMAX","LDEFAULT","LMAX","FMAX","BREAK","OPTIONS"
!!
USER = UINFS(1)
CT = 0
CYCLE
CT = CT+1
AGN: READ LINE(S)
STOP IF S = ".END" OR S = "STOP" OR S = "*"
UNLESS S -> OPT.("=").REST START
PRINTSTRING("
THE FORMAT IS OPTION = VALUE
")
-> AGN
FINISH
NJ = 0
CYCLE I = 1,1,8
IF OPT = OPTS(I) THEN NJ = I AND EXIT
REPEAT
IF NJ = 0 THEN START
PRINTSTRING("
??
OPTIONS ARE FACLEVEL,MDEFAULT,MMAX,LDEFAULT,LMAX,FMAX,BREAK,OPTIONS
")
-> AGN
FINISH
IF NJ # 8 THEN START
I = STOI(REST,N)
IF I = 2 THEN PRINTSTRING("
NON-NUMERIC DIGIT IN ". C
REST."
") AND -> AGN
! CHECK VALUE IS WITHIN PERMITTED RANGE
!!
-> NJS(NJ)
NJS(1):
! FACILITY LEVEL
-> BADVALUE UNLESS 1 <= N <= 2
-> GOODVALUE
NJS(2):
NJS(3):
! CPU LIMITS
-> BADVALUE UNLESS 10 <= N <= 3000
-> GOODVALUE
NJS(4):
NJS(5):
! OUTPUT LIMITS
-> BADVALUE UNLESS 50 <= N <= 100000
-> GOODVALUE
NJS(6):
! MAXIMUM FILE SIZE
-> BADVALUE UNLESS 10 <= N <= 1024
N=N*1024
-> GOODVALUE
NJS(7):
! OUTPUT BREAK
-> GOODVALUE
BADVALUE:
PRINTSTRING("
VALUE ")
WRITE(I,1)
PRINTSTRING(" FOR ".OPTS(NJ). C
" IS OUTSIDE PERMITTED LIMITS ")
NEWLINE
GOODVALUE:
FINISH
LJOBBERS = JOBBERS
CYCLE
UNLESS LJOBBERS -> JOBBER.(",").LJOBBERS C
THEN JOBBER = LJOBBERS AND LJOBBERS = ""
FSYS = -1
IF CT = 1 START
FLAG = DPERMISSION(JOBBER,USER,"",FILE,FSYS,1,3)
IF FLAG # 0 THEN SJDERROR("DPERMIT",FLAG)
FINISH
CONNECT(JOBBER.".".FILE,3,0,0,IN,FLAG)
IF FLAG # 0 THEN SJDERROR("CONNECT",FLAG)
JOPT == RECORD(IN_CONAD+32)
IF NJ # 8 THEN INTEGER(ADDR(JOPT)+((NJ-1)*4)) = N C
ELSE JOPT_OPTIONS = PARM(REST,JOPT_OPTIONS)
EXIT IF LJOBBERS = ""
REPEAT
REPEAT
END ; ! OF SET J OPTION
ENDOFFILE