!*
!*
!*E; %EXTRINSICINTEGER JDEFADDR
!*NE %EXTERNALLONGLONGREAL ICL9LDLIBPROC
!*
!*E; %CONSTINTEGER OPSYS=0
!*NE %OWNINTEGER OPSYS; ! 0 EMAS
! 1 VME/B
! 2 VME/K
!*
!*NE %OWNSTRING(32) INPUTFILE
EXTRINSICSTRING (6) SSOWNER
OWNSTRING (6) JNUM ;! PROCESS NUMBER
OWNSTRING (32) JOBOWNER
OWNSTRING (32) SSJOBNAME
OWNSTRING (32) DELIVERY
!*NE %OWNSTRING(31) VERSION
!*E; %SYSTEMSTRING(6) %FNSPEC RELEASE
!*E;%OWNSTRING (8) SJ VERSION=""
OWNINTEGER JOBSTARTCPU, JOBENDCPU
OWNINTEGER MONCPU
OWNLONGREAL CPUBASE
OWNINTEGER JOBNUM=0
OWNINTEGER JOBACTIVE=0
OWNINTEGER NEWP=0; ! 0 NEWPAGE NOT NEC. 1 NEWPAGE REQUIRED
!*
!*E NOTE ORDER OF THESE OWNS IS CRITICAL ON EMAS
OWNINTEGER JOBBER FACILITY LEVEL=2
OWNINTEGER DEFAULT CPU LIMIT=30
OWNINTEGER MAX CPU LIMIT=300
!*
OWNINTEGER DEFAULT OUTPUT LIMIT=1000
OWNINTEGER MAX OUTPUT LIMIT=5000
!*E; %OWNINTEGER DUMFMAX
!*E; %EXTERNALINTEGER DEFAULT FMAX = X'4000'
!*NE %OWNINTEGER DEFAULT FMAX=-1
!*NE %OWNINTEGER VMOWNER SET; ! 1 AFTER CALL ON SET VM OWNER
!*NE %OWNINTEGER FILESTORE SET; ! 1 AFTER CALL ON SET DEFAULT FILESTORE
!*
OWNINTEGER OUTPUT BREAK=5000
OWNINTEGER JOB CPU LIMIT
OWNINTEGER JOB OUTPUT LIMIT
!*
!*NE %OWNINTEGER RESETFILESTORE
!*NE %OWNSTRING(64) JBRINPUT
!*NE %EXTRINSICINTEGER ICL9CESFS
!*NE %EXTRINSICINTEGER ICL9CEAVOLS
!*
!*
EXTERNALROUTINESPEC DPRINTSTRING(STRING (255) S)
!*
!****** BBASE FUNCTIONS
!*
SYSTEMINTEGERFNSPEC FASTFILEOP(INTEGER ADA)
!%SYSTEMINTEGERFNSPEC FILEOP( %C
! %INTEGER ACCESS DR ADDR, ACCESS TYPE, OPTYPE, BUFFAD, %C
! BUFFLEN, DISPLACEMENT)
!*NE %SYSTEMINTEGERFNSPEC DESCRIBE FILE(%STRING (32) NAME, %C
!*NE %INTEGER ORGANISATION, RECTYPE, RECMIN, RECMAX, BLKSIZE)
!*NE %SYSTEMINTEGERFNSPEC READ FILE DESCRIPTION(%INTEGER CCY, %C
!*NE %INTEGERNAME ORG, CLASS, TYPE, MIN, MAX)
SYSTEMINTEGERFNSPEC CREATE FILE(STRING (32) NAME, DESC, C
INTEGER INITSIZE, MAXSIZE, EXTSIZE, RECSIZE,BLKSIZE,RTYPE,FE)
SYSTEMINTEGERFNSPEC WORK FILE(STRING (32) DESC, C
INTEGER INIT, MAX, EXT, C
INTEGERNAME FILECCY, ORG, DEVCLASS, RECTYPE, FE, MINREC, C
MAXREC)
SYSTEMINTEGERFNSPEC DEFINE FILE(INTEGER TYPE, P, C
STRING (32) IDEN, C
INTEGERNAME CURRENCY, FILE ORG, DEVCLASS, RECTYPE, FE, C
MINREC, MAXREC)
SYSTEMINTEGERFNSPEC CLOSE FILE(INTEGER ROUTE, ACCESS CUR AD)
!*NE %SYSTEMINTEGERFNSPEC DELETE FILE(%STRING (32) NAME)
!*NE %SYSTEMINTEGERFNSPEC READ JS VAR(%STRING (31) NAME, %C
!*NE %INTEGER OPTION, RADDR)
! %SYSTEMINTEGERFNSPEC WRITE JS VAR(%%STRING(31) NAME, %C
INTEGER OPTION,RADDR)
!*NE %SYSTEMINTEGERFNSPEC NEW VM OWNER(%STRING (32) NEW OWNER)
!*NE %SYSTEMINTEGERFNSPEC OLD VM OWNER
!*NE %SYSTEMINTEGERFNSPEC SET DEFAULT FILESTORE(%STRING (32) OWNER)
SYSTEMINTEGERFNSPEC READ CPU TIME
SYSTEMINTEGERFNSPEC SET CPU LIMIT(INTEGER MSECS)
!*NE %SYSTEMROUTINESPEC SET R LEVEL(%INTEGER LEVEL)
!%SYSTEMINTEGERFNSPEC LOGJNLMSG(%INTEGER TYPE,MESSLEN,MESSAD)
!*NE %SYSTEMINTEGERFNSPEC LD
!*NE %SYSTEMINTEGERFNSPEC INIT JOB BASE(%STRING(64) INPUT,%INTEGER RESET)
!*NE %SYSTEMINTEGERFNSPEC PRIME CPU TIMER(%ROUTINE CONTPROC)
SYSTEMROUTINESPEC JBR ACNT(INTEGER EP,STRING (8) TIME, C
STRING (255) TEXT)
!*E; %SYSTEMROUTINESPEC DESTROYFILE (%STRING(31) FILE,%INTEGERNAME FLAG)
! %SYSTEMROUTINESPEC STOPBASE
!*NE %SYSTEMINTEGERFNSPEC EXEC CP TEXT(%STRING(255) TEXT)
!*
!****** MAIN
!*
SYSTEMROUTINESPEC SIM2(INTEGER I, J, K, INTEGERNAME F)
SYSTEMROUTINESPEC SIGNAL(INTEGER EP, P1, P2, INTEGERNAME F)
SYSTEMINTEGERMAPSPEC COMREG(INTEGER I)
SYSTEMINTEGERFNSPEC COMPILE(INTEGER I, MODE, NEWP)
SYSTEMROUTINESPEC SJRUN(STRING (255) S)
SYSTEMROUTINESPEC LOG99
!*NE %SYSTEMROUTINESPEC ETOI(%INTEGER AD,L)
!*NE %SYSTEMROUTINESPEC ITOE(%INTEGER AD, L)
SYSTEMROUTINESPEC FILL(INTEGER L, FROM, WITH)
SYSTEMROUTINESPEC MOVE(INTEGER L, FROM, TO)
SYSTEMROUTINESPEC INITMAIN(INTEGER OPSYS,MODE)
!*E; %CONSTSTRING(8) %NAME TIME=X'80C0004B'
!*E; %CONSTSTRING(8) %NAME DATE=X'80C0003F'
!*NE %SYSTEMROUTINESPEC DATIME(%STRINGNAME DATE, TIME)
!*NE %SYSTEMROUTINESPEC ONTRAPB(%INTEGER EVENT,SUBCLASS,CLASS)
SYSTEMLONGREALFNSPEC CPUTIME
!*
!****** FILE
!*
SYSTEMINTEGERMAPSPEC FDMAP(INTEGER I)
SYSTEMINTEGERFNSPEC INITLOAD
SYSTEMINTEGERFNSPEC INITCOMP(INTEGER COMP, MODE, NEWP)
SYSTEMINTEGERFNSPEC SET CONTENT LIMIT(STRING (15) S, C
INTEGER NEWCONT)
SYSTEMINTEGERFNSPEC PARM(STRING (255) S)
SYSTEMROUTINESPEC OUTFILE(STRING (15) S, C
INTEGER LEN, MAXLEN, USE, INTEGERNAME CONAD,FLAG)
SYSTEMINTEGERFNSPEC CLOSE(INTEGER AFD)
SYSTEMINTEGERFNSPEC RESET FDS
SYSTEMINTEGERFNSPEC NEW DESC( C
INTEGER DSNUM, TYPE, ACCESS ROUTE, MODE, IDENTYPE, C
STRING (31) IDEN, INTEGERNAME AFD)
SYSTEMINTEGERFNSPEC OPEN(INTEGER AFD, MODE)
SYSTEMINTEGERFNSPEC SETPARS(INTEGER COUNT,STRING (255) S, C
STRINGARRAYNAME PAR,KEY)
!*E; %SYSTEMROUTINESPEC FIO INIT(%INTEGER MODE)
!*
!****** DIAG
!*
SYSTEMROUTINESPEC ALLDIAGS(INTEGER PC)
SYSTEMROUTINESPEC SSMESS(INTEGER N)
SYSTEMROUTINESPEC SSMESSA(INTEGER N, STRING (63) A)
SYSTEMROUTINESPEC SSERR(INTEGER N)
!*
!****** JBR
!*
!%SYSTEMROUTINESPEC AMEND(%INTEGER INPUT SET)
SYSTEMROUTINESPEC EDIT
!*
!*
ROUTINESPEC JBRCLI(INTEGERNAME JOBSTATE)
INTEGERFNSPEC GET ROUTE(INTEGER AFD)
!*E %INTEGERFNSPEC RESET SPOOL
ROUTINESPEC CLOSE FILES(INTEGER MODE, INTEGERNAME LINES, TRANS)
INTEGERFNSPEC FILE DEFINITION(STRING (255) PARAMS)
INTEGERFNSPEC DELETEF(STRING (255) PARAMS)
INTEGERFNSPEC LISTF(STRING (255) PARAMS)
INTEGERFNSPEC INPUTF(STRING (255) PARAMS)
! %INTEGERFNSPEC AMENDCHECK(%STRING (255) PARAMS, %INTEGERNAME INPUT)
INTEGERFNSPEC EDITCHECK(STRING (255) PARAMS)
INTEGERFNSPEC INFILE2(STRING (63) IDEN)
ROUTINESPEC COMP(INTEGER I, STRING (255) S, INTEGER NEWP)
INTEGERFNSPEC STOI(STRING (255) S)
!*
RECORDFORMAT NRFDFMT(INTEGER LINK, DSNUM, C
BYTEINTEGER STATUS, ACCESS ROUTE, VALID ACTION, C
CUR STATE, C
BYTEINTEGER MODEOFUSE, MODE, FILE ORG, DEV CLASS, C
BYTEINTEGER REC TYPE, FLAGS, LM, RM, C
INTEGER ASVAR, AREC, RECSIZE, MINREC, MAXREC, MAXSIZE, C
ROUTECCY, INTEGER C0, C1, C2, C3, TRANSFERS, C
INTEGER DARECNUM, SPARE1, SPARE2, STRING (31) IDEN)
!*
RECORDFORMAT TCFMT(INTEGER PAGE COUNT, USER TRANSFER COUNT, C
USER PRINT COUNT, TOTAL PRINT COUNT, OUTPUT LIMIT, C
PAGE SIZE)
!*
!*NE %CONSTINTEGER ALIENMAX=X'40000'
!*
!*E; %SYSTEMROUTINE INITJBR
!*NE %ROUTINE INITJBR(%INTEGER SYSTEM)
INTEGER I
!*NE %INTEGER J, BASE, CUR, MAX,CCY
!*NE %LONGINTEGER K
!*NE %RECORDNAME F(NRFDFMT)
RECORDNAME TC(TCFMT)
!*NE %CONSTSTRING(14)%ARRAY JS VAR(0:1)= %C
!*NE 'ICL9CEBREAK',
!*NE 'ICL9CEPSIZE'
!*NE %SWITCH V(0:1)
!*NE OPSYS=SYSTEM
TC==RECORD(COMREG(49)); ! TRANSFER COUNT RECORD
TC_PAGESIZE=66
!*NE OUTPUT BREAK = 5000
!*NE %UNLESS OPSYS=1 %THEN ->INIT2;! PROCESS JSVARS FOR B ONLY
!*NE J=ADDR(K)
!*NE %CYCLE I=0,1,1
!*NE %IF READ JS VAR(JS VAR(I),1,J)=0 %THEN ->V(I)
!*NE REP: %REPEAT
!*E; %IF JDEFADDR#0 %THEN MOVE(28,JDEFADDR+32,ADDR( %C
JOBBER FACILITY LEVEL)) AND DEFAULT FMAX=DUMFMAX
!*NE ->INIT2
!*
!*NE V(0): OUTPUT BREAK=K
!*NE ->REP
!*NE V(1): TC_PAGE SIZE=K
!*NE ->REP
!*
!*NE INIT2:
!*NE ICL9CESFS = ((MAX OUTPUT LIMIT+OUTPUT BREAK)*110)//800
!*NE I=INIT JOB BASE(JBRINPUT,RESETFILESTORE)
!*
!*NE %IF OPSYS=1 %THEN I=PRIME CPU TIMER(ONTRAPB)
!*
!*E; SJVERSION=RELEASE
JOBNUM=0
JOBACTIVE=0
NEWP=0
!*NE VMOWNER SET=0
!*NE FILESTORE SET=0
!*E; JNUM=SSOWNER
!*E; MOVE(2,ADDR(JNUM)+5,ADDR(JNUM)+1)
!*E; LENGTH(JNUM)=2
I=INITLOAD
I=INITCOMP(0,0,0)
!*E; %IF I#0 %THEN SSERR(I)
!*E I=RESET SPOOL
! OUTFILE('S#RFMT',4096,4096,0,BASE,I)
! %IF OPSYS=2 %THENSTART;! K ONLY
! %IF INPUTFILE#'' %THENSTART;! ASSIGN INPUT FILE
! I=DEFINE FILE(0,0,INPUTFILE,CCY,J,J,J,J,J,J)
! %IF I<=0 %THENSTART
! K=CCY
! I=WRITE JS VAR('INPUT',1,ADDR(K))
! %FINISHELSESTART;! FAILED TO ASSIGN
! LOG99
! PRINTSTRING('*** INPUT FILE DOES NOT EXIST
!')
! STOPBASE
! %FINISH
! %FINISHELSESTART;! CHECK INPUT DEFINED
! I=READ JS VAR('INPUT',1,ADDR(K))
! %IF I#0 %THENSTART
! LOG99
! PRINTSTRING('*** NO INPUT FILE SPECIFIED
!')
! STOPBASE
! %FINISH
! %FINISH
! %FINISH
SELECTINPUT(108)
!*NE F==RECORD(FDMAP(108))
!*NE %RETURN %UNLESS F_DEVCLASS=9; ! ALIEN DATA REQUIRES TO BE SPOOLED
!*NE OUTFILE('SS#ALIEN',ALIENMAX,ALIENMAX,0,BASE,I)
!*NE %IF I#0 %THEN SSERR(I)
!*NE CUR=BASE
!*NE MAX=BASE+ALIENMAX-160
!*NE READ: I=FASTFILEOP(ADDR(F_C0))
!*NE %IF I>0 %THEN ->EOF
!*NE FILL(80-F_RECSIZE,F_AREC+F_RECSIZE,X'40')
!*NE MOVE(80,F_AREC,CUR)
!*NE CUR=CUR+80
!*NE %UNLESS CUR>MAX %THEN ->READ
!*NE EOF: F_ACCESS ROUTE=7
!*NE F_C1=BASE
!*NE F_C2=BASE
!*NE F_C3=CUR
!*
END ; ! INITJBR
!*
!*NE %SYSTEMINTEGERFN JBR ENTRY(%INTEGER ENTRY,%INTEGERNAME PARAM)
!*NE %INTEGER I
!*NE %IF ENTRY=0 %THENSTART
!*NE SJ VERSION = " E 1.4 "
!*NE SJ VERSION=STRING(COMREG(58))
!*NE I=ADDR(ICL9LDLIBPROC)
!*NE LONGINTEGER(I)=LONGINTEGER(COMREG(60))
!*NE LONGINTEGER(I+8)=0
!*NE INIT JBR(PARAM)
!*NE %FINISH
!*NE %IF ENTRY=1 %THENSTART
!*NE JBRCLI(PARAM)
!*NE %FINISH
!*NE %IF ENTRY=2 %THENSTART
!*NE %RESULT=GET ROUTE(PARAM)
!*NE %FINISH
!*NE %RESULT=0
!*NE %END;! JBR ENTRY
!*
!*E %CONSTINTEGER SPOOL AREA=X'40000'
!*E !*
!*E %OWNINTEGER SPOOL BASE
!*E %OWNINTEGER SPOOL FREE
!*E %OWNINTEGER SPOOL MAX
!*E !*
!*E %INTEGERFN RESET SPOOL
!*E %INTEGER F
!*E OUTFILE('SS#SPOOLIN',SPOOL AREA,SPOOL AREA,0,SPOOL BASE,F)
!*E %IF F=0 %THEN %START
!*E INTEGER(SPOOL BASE)=32
!*E INTEGER(SPOOL BASE+12)=3
!*E SPOOL FREE=SPOOL BASE+32
!*E !*NE SPOOL FREE=SPOOL BASE
!*E SPOOL MAX=SPOOL BASE+SPOOL AREA
!*E %FINISH
!*E %RESULT =F
!*E %END; !RESET SPOOL
!*
!*
!*
!*E !*
SYSTEMROUTINE JBRPARS(STRING (255) S)
CONSTSTRING (8)ARRAY KEY(1:16)= C
"INPUT","FACLEVEL","MDEFAULT","MMAX","LDEFAULT","LMAX","FMAX","BREAK",C
"IN","FA","MD","MM","LD","LM","FM","BR"
STRING (63)ARRAY PAR(1:16)
INTEGER I
I=SETPARS(16,S,PAR,KEY)
CYCLE I=1,1,8
IF PAR(I)="" AND PAR(I+8)#"" THENSTART
PAR(I)=PAR(I+8)
FINISH
REPEAT
!*NE INPUTFILE=PAR(1)
IF PAR(2)#'' THENSTART ;! FACLEVEL
I=STOI(PAR(2))
IF I>2 THEN I=2
IF 1<=I<=2 THEN JOBBER FACILITY LEVEL=I
FINISH
IF PAR(3)#'' THENSTART ;! MDEFAULT
I=STOI(PAR(3))
IF 10<=I<=3000 THEN DEFAULT CPU LIMIT=I
FINISH
IF PAR(4)#'' THENSTART ;! MMAX
I=STOI(PAR(4))
IF 10<=I<=3000 THEN MAX CPU LIMIT=I
FINISH
IF PAR(5)#'' THENSTART ;! LDEFAULT
I=STOI(PAR(5))
IF 50<=I<=100000 THEN DEFAULT OUTPUT LIMIT=I
FINISH
IF PAR(6)#'' THENSTART ;! LMAX
I=STOI(PAR(6))
IF 50<=I<=100000 THEN MAX OUTPUT LIMIT=I
FINISH
IF PAR(7)#'' THENSTART
I=STOI(PAR(7))
IF 10<=I<=1024 THEN DEFAULT FMAX=I
FINISH
IF PAR(8)#'' THENSTART
I=STOI(PAR(8))
IF I>0 THEN OUTPUT BREAK=I
FINISH
END ;! JBRPARS
!*
!*
!*NE %SYSTEMROUTINE BJBRPARS(%LONGINTEGER INPUT, %C
!*NE %INTEGER FACLEVEL,MDEFAULT,MMAX, %C
!*NE LDEFAULT,LMAX,FMAX, %C
!*NE %LONGINTEGER DFSMACRO,AVOLS)
!*NE %SWITCH V(0:1)
!*NE %INTEGER LEN,ADDRS,I,J
!*NE %LONGINTEGERARRAY A(0:1)
!*NE %STRING(64) S
!*NE MAX CPULIMIT = MMAX
!*NE DEFAULT CPULIMIT = MDEFAULT
!*NE MAX OUTPUT LIMIT = LMAX
!*NE DEFAULT OUTPUT LIMIT = LDEFAULT
!*NE JOBBER FACILITY LEVEL = FACLEVEL
!*NE DEFAULT FMAX = FMAX
!*NE ICL9CEAVOLS = (AVOLS << 8) >>40
!*NE A(0) = INPUT
!*NE A(1) = DFSMACRO
!*NE %CYCLE I = 0,1,1
!*NE LEN = (A(I) << 8) >> 40
!*NE ADDRS = A(I) & X'00000000FFFFFFFF'
!*NE J = ADDR(S)+1
!*NE MOVE(LEN,ADDRS,J)
!*NE ETOI(J,LEN)
!*NE LENGTH(S) = LEN
!*NE ->V(I)
!*NE REP:
!*NE %REPEAT
!*NE %RETURN
!*NE !*
!*NE V(0): JBRINPUT = S
!*NE -> REP
!*NE V(1): RESETFILESTORE = 0
!*NE %IF S # "" %THEN %START
!*NE J = EXEC CP TEXT (S)
!*NE %IF J <= 0 %THEN RESETFILESTORE = 1
!*NE %FINISH
!*NE -> REP
!*NE %END
!*
!*
!***********************************************************************
!*
!*
ROUTINESPEC JOB(STRING (255) S)
ROUTINESPEC ENDJOB
INTEGERFNSPEC GET COMMAND(STRINGNAME COMMAND, PARAMS, C
INTEGER JOBSTATE)
!*
CONSTINTEGER NUMC=29
CONSTSTRING (10)ARRAY CLIST(0:29)= C
'ENDIPT',
'JOB',
'ENDJOB',
'OPTIONS',
'ALGOL',
'FORTRAN',
'IMP',
'RUN',
'INPUTFILE',
'DELETEFILE',
'#MEND',
'ALGOLE',
'FORTRANG',
'LISTFILE',
'FORTE',
'EDIT',
'####',
'####',
'DEFINEFILE',
'DIAGNOSE',
'ALLDIAGS',
'MAXDIAGS',
'SETRLEVEL',
'MONCPU',
'NROBJ',
'LOG99',
'PASCAL',
'TESTCOMP',
'LD',
'JOBBER'
!*
CONSTINTEGER NUMMAPC=10
CONSTSTRING (8)ARRAY MAPCLIST(1:10)= C
'INF',
'XF',
'DEFINE',
'DFF',
'INPUT',
'DELETE',
'LIST',
'LF',
'//',
'ED'
CONSTBYTEINTEGERARRAY MAPC(1:10) = 8,9,18,18,8,9,13,13,0,15
!*
!*E; %SYSTEMROUTINE JBRCLI(%INTEGERNAME JOBSTATE)
!*NE %ROUTINE JBRCLI(%INTEGERNAME JOBSTATE)
INTEGER I, J, F, CNUM, SAVE OPTIONS
LONGREAL CPU
!*E; %OWNINTEGER C46=0
STRING (31) COMMAND
STRING (255) PARAMS
!*NE %LONGINTEGERARRAYFORMAT COMPSF(1:6)
!*NE %LONGINTEGERARRAYNAME COMPS
SWITCH C(0:31)
!*
!*NE COMPS==ARRAY(COMREG(59),COMPSF)
NEXT: COMREG(1)=1
!*E; %IF COMREG(46)<=0 %THEN COMREG(46)=C46 ;! RESET COMREG 46
IF COMREG(2)=2 THEN START ; ! OP INT LEVEL
IF JOBACTIVE#0 THEN ENDJOB
->QUIT
FINISH
IF MONCPU#0 THEN START
CPU=CPUTIME
NEWLINE
PRINT(CPU-CPUBASE,2,3)
PRINTSTRING(' SECS.
')
CPUBASE=CPU
FINISH
SELECTINPUT(108)
SELECTOUTPUT(99)
CLOSE FILES(1,I,J); ! BUT RETAIN DESCRIPTORS
I=GET COMMAND(COMMAND,PARAMS,JOBSTATE)
IF I#0 THEN START
IF I<0 THEN START
EOF: IF JOB ACTIVE#0 THEN ENDJOB
QUIT: JBR ACNT(2,'','');! CLOSE ACCOUNTING FILE
!*NE %IF RESETFILESTORE = 1 %THEN %C
!*NE I = EXEC CP TEXT('DEFAULTVOLUMES(PRESELECT = TRUE,READ = TRUE)')
RETURN
FINISH
BADC: SSMESS(I)
->NEXT
FINISH
CYCLE CNUM=0,1,NUMC
IF COMMAND=CLIST(CNUM) THEN ->VALIDC
REPEAT
CYCLE J=1,1,NUMMAPC
IF COMMAND=MAPCLIST(J) THEN CNUM=MAPC(J) AND ->VALIDC
REPEAT
I=206; ! INVALID CONTROL STATEMENT
->BADC
!*
VALIDC:
IF CNUM>1 AND CNUM#29 AND JOBACTIVE=0 THEN ->NEXT
IF CNUM>2 THEN START
NEWLINE
IF JOB STATE>1 THEN ->NEXT; !SKIPPING TO END OF JOB
FINISH
!*
!* POPUP EXCESS CONTINGENCY TRAPS
!*
SIGNAL(6,ADDR(J),0,F)
WHILE J>0 CYCLE
SIGNAL(1,0,0,F)
J=J-1
REPEAT
!*
!* RESET AUX STACK
!*
J=COMREG(37); ! BASE OF SS#AUXST
INTEGER(J)=J+16
IF OPSYS = 1 THEN INTEGER(J+8) = J + X'40000' C
ELSE INTEGER(J+8) = J + X'40000'
!*
!* SAVE SF FOR DIAGNOSTIC RECOVERY
!*
*STSF_J
COMREG(36)=J
->C(CNUM)
!*
!****** ENDIPT
C(0): ->EOF
!*
!****** JOB
C(1): JOBSTATE=1
JOB(PARAMS)
->NEXT
!*
!****** ENDJOB
C(2): ENDJOB
->NEXT
!*
!****** OPTIONS
C(3): I=PARM(PARAMS)
->NEXT
!*
!****** ALGOL
C(4):
!*E; C46=COMREG(46) ;! REMEMBER C46
!*E; COMREG(46)=0
!*E COMREG(46)=-1 ;! AND COPILER ASSUMES SMALL WORKSPACE REQUIRED
->COMP
!*
!****** FORTRAN
C(5):
COMREG(28)=(COMREG(27)>>25)&X'E'
!*
!****** IMP
C(6):
COMP: SAVE OPTIONS=COMREG(27)
!*NE %IF COMPS(CNUM-3)=0 %THEN I=206 %AND ->BADC
COMP1: COMP(CNUM,PARAMS,NEWP)
!*NE COMP1:COMP(CNUM-3,PARAMS,NEWP)
COMREG(27)=SAVE OPTIONS
NEWP=1
->NEXT
!*
!****** RUN
C(7): COMREG(1)=3
FIO INIT(-1)
SJRUN(PARAMS)
I=SET CONTENT LIMIT('SS#GLA',0)
!*UKC NEWPAGE
!*UKC;NEWLINES(5)
NEWP=0
->NEXT
!*
!****** INPUT FILE
C(8): I=INPUTF(PARAMS)
SELECTOUTPUT(99)
IF I>0 THEN START
IF I=219 THEN SSERR(219) ELSE SSMESS(I)
! ABORT IF FILE DOES NOT EXIST
FINISH
->NEXT
!*
!****** DELETE FILE
C(9): I=DELETEF(PARAMS)
IF I>0 THEN SSMESS(I)
->NEXT
!*
!****** AMEND
C(10):!I=AMENDCHECK(PARAMS,J)
! %IF I>0 %THEN SSMESS(I) %AND ->NEXT
! AMEND(J)
->NEXT
!*
!****** ALGOLE
C(11):
!*
!****** FORTRANG
C(12):CNUM=CNUM-7
->COMP
!*
!****** LIST FILE
C(13):I=LISTF(PARAMS)
IF I>0 THEN SSMESS(I)
->NEXT
!*
!****** FORTE
C(14):SAVE OPTIONS=COMREG(27)
COMREG(27)=COMREG(27)&X'FFBFFFFF'
CNUM=5
->COMP1
!*
!****** EDIT
C(15):I=EDITCHECK(PARAMS)
IF I>0 THEN SSMESS(I) AND ->NEXT
EDIT
->NEXT
!*
!****** STREAM
C(16):
!*
!****** SQFILE
C(17):
!*
!****** DAFILE
C(18):I=FILE DEFINITION(PARAMS)
->NEXT
!*
!****** DIAGNOSE
C(19):COMREG(25)=1
->NEXT
!*
!****** ALLDIAGS
C(20):ALLDIAGS(0)
->NEXT
!*
!****** MAXDIAGS
C(21):COMREG(25)=0
->NEXT
!*
!****** SET R LEVEL
C(22):
!*NE %IF PARAMS#0 %THEN %START
!*NE I=CHARNO(PARAMS,1)
!*NE %IF '0'<=I<='7' %THEN SET R LEVEL(I&7) %AND ->NEXT
!*NE %FINISH
!*NE I=202
!*NE ->BADC
!*E; ->NEXT
!*
!****** MONCPU
C(23):MONCPU=1
CPUBASE=CPUTIME
->NEXT
!*
!****** NROBJ
C(24):->NEXT
!*
!****** LOG99
C(25):LOG99
->NEXT
!****** PASCAL
C(26):
!*
!****** TESTCOMP
C(27):CNUM=CNUM-18;! 8 PASCAL 9 TESTCOMP
!4 ALGOL 5 FORTRAN 6 IMP
->COMP
!*
!****** LD
C(28): IF OPSYS # 1 THEN I = 206 AND -> BADC
!*NE %IF VM OWNER SET<=0 %THENSTART
!*NE I=NEW VM OWNER(JOBOWNER)
!*NE %IF I#0 %THEN SSMESS(216) %AND ->NEXT
!*NE %FINISH
!*NE I = LD
!*NE %IF I > 0 %THEN SSMESS(I)
-> NEXT
!*
C(29):
JBRPARS(PARAMS)
-> NEXT
!*
END ; ! JBRCLI
!*
INTEGERFN GET COMMAND(STRINGNAME COMMAND, PARAMS, C
INTEGER JOBSTATE)
INTEGERFNSPEC GET CH
BYTEINTEGERARRAY C(0:31)
BYTEINTEGERARRAY P(0:255)
BYTEINTEGERARRAY CHS(0:160)
INTEGER CHCUR, CHLEN, NC, NP, FLAG, I
L0: FLAG=0
NC=0; NP=0
CHCUR=1; CHLEN=0
L1: I=GETCH
->END IF FLAG#0
UNLESS I='(' THEN START
IF I='_' THEN ->L1; ! IGNORE BREAK CHARS.
IF NC=31 THEN RESULT =206; ! INVALID CONTROL STATEMENT
NC=NC+1
C(NC)=I
->L1
FINISH
IF NC=0 THEN RESULT =206
L2: I=GETCH
->END IF FLAG#0
IF NP=255 THEN RESULT =202; ! PARAM STRING TOO LONG
NP=NP+1
P(NP)=I
->L2
!*
END: IF FLAG=2 THEN RESULT =-1; ! END OF FILE
IF NP>0 THEN START
I=P(NP)
IF I=',' THEN FLAG=0 AND ->L2; !TO PROCESS CONTINUATION
IF I=')' THEN NP=NP-1 ELSE RESULT =206
!ONLY , ARE ) VALID
FINISH
IF NC=0 THEN ->L0; ! ALLOW // <BLANK>
C(0)=NC
P(0)=NP
COMMAND=STRING(ADDR(C(0)))
PARAMS=STRING(ADDR(P(0)))
RESULT =0
!*
INTEGERFN GETCH
INTEGER I, J
READ: IF CHCUR>CHLEN THEN START
NEXTL: SIM2(0,ADDR(CHS(1)),1,CHLEN)
I=CHS(1)
IF I=25 THEN FLAG=2 AND RESULT =0; ! END OF FILE
UNLESS I='/' AND CHS(2)='/' THEN ->NEXTL
IF JOBACTIVE#0 THEN START
IF CHLEN>2 THEN START
CYCLE I=3,1,CHLEN
J=CHS(I)
IF J#' ' THEN START
IF J='J' THEN ->SET ELSE START
IF JOBSTATE>1 AND J#'E' THEN ->NEXTL
! JOB ABORTING, ONLY JOB AND ENDJOB RELEVANT
EXIT
FINISH
FINISH
REPEAT
FINISH
CHS(0)=CHLEN
NEWLINES(2)
PRINTSTRING(STRING(ADDR(CHS(0))))
FINISH
SET: CHCUR=3
FINISH
I=CHS(CHCUR)
CHCUR=CHCUR+1
IF I=10 THEN CHLEN=0 AND FLAG=1 AND RESULT =1
!NEWLINE
->READ UNLESS 32<I<=126
RESULT =I
END ; !GETCH
END ; !GET COMMAND
!*
!***********************************************************************
!*
OWNSTRING (8) START TIME
!*NE %OWNSTRING(10) DATE,TIMEDATE,TIME
!*
ROUTINE HEAD(INTEGER MODE)
!* MODE = 0 START
!* 1 END
INTEGER I
START TIME = TIME
CYCLE I=1,1,6
PRINTSTRING('***'.SJVERSION.'*** ')
IF MODE=0 THEN PRINTSTRING('STARTJOB') C
ELSE PRINTSTRING(' ENDJOB')
WRITE(JOBNUM,3); SPACES(3)
PRINTSTRING(SSJOBNAME)
SPACES(6)
PRINTSTRING(DELIVERY)
SPACES(52-LENGTH(SSJOBNAME)-LENGTH(DELIVERY))
PRINTSTRING(DATE.' '.TIME)
! PRINTSTRING(' ***'.SJVERSION.'***
!')
PRINTSTRING(' ***
')
REPEAT
END ; ! HEAD
!*
INTEGERFN STOI(STRING (255) S)
! RESULT IS VALUE REPRESENTED BY THE STRING PARAM TAKEN AS A STRING OF
! DECIMAL DIGITS. ERROR RESULT IS -1 (BAD CHAR IN STRING OR BAD
! LENGTH)
INTEGER I, Q, L, AS, CH
AS=ADDR(S)
L=LENGTH(S)
RESULT =-1 IF L>9
RESULT =0 IF L=0
I=0
CYCLE Q=1,1,L
CH=BYTEINTEGER(AS+Q)
RESULT =-1 UNLESS '0'<=CH<='9'
I=10*I+CH-48
REPEAT
RESULT =I
END ; ! STOI
!*
!*
ROUTINE SET OUTPUT LIMIT( C
INTEGER PRINT LIMIT, OUTPUT BREAK)
RECORDNAME TC(TCFMT)
INTEGER I, J
TC==RECORD(COMREG(49))
IF OUTPUT BREAK#0 THEN START ; ! ALLOW EXTENSIONS FOR PROTECTION
IF TC_TOTAL PRINT COUNT>=OUTPUT BREAK THEN START
INITMAIN(OPSYS,1); ! TO SET OUTFD=0
I=FDMAP(99)
J=CLOSE(I)
J=NEW DESC(99,1,2,2,0,'',I)
COMREG(23)=0
SELECT OUTPUT(99)
TC_TOTAL PRINT COUNT=0
FINISH
TC_USER TRANSFER COUNT=0
TC_USER PRINT COUNT=0
!*E; TC_PAGE COUNT=0
!*NE TC_PAGE COUNT=TC_PAGE SIZE
!*E; TC_PAGE COUNT=TC_PAGESIZE %UNLESS JOBNUM<=1
FINISH
TC_OUTPUT LIMIT=PRINT LIMIT+60
END ; ! SET OUTPUT LIMIT
!*
!*
!*NE %OWNSTRING(33) JBRJOBNAME
!*NE !*
!*NE %EXTERNALROUTINE ICL9CEJBRJOBNAME(%LONGINTEGERNAME DESC)
!*NE %INTEGER I,J
!*NE I=X'18000000'!LENGTH( JBRJOBNAME)
!*NE J=ADDR(JBRJOBNAME)+1
!*NE DESC=LONGINTEGER(ADDR(I))
!*NE %END
!*
ROUTINE JOB(STRING (255) S)
CONSTSTRING (8)ARRAY KEY(1:7)= C
"JOBNAME","DELIVERY","TIME","LINES","T","L","DEL"
STRING (63) ARRAY PAR(1:7)
STRING (63) T, U, V, W, X, Y
INTEGER I, J, K, ERR, ERR1, ERR2
STRING (63) S1, S2
COMREG(24)=16
NEWP=0
ERR=0
ERR1=0
ERR2=0
IF JOBACTIVE#0 THEN ENDJOB
JOB OUTPUT LIMIT=DEFAULT OUTPUT LIMIT
JOB CPU LIMIT=DEFAULT CPU LIMIT
IF S->U.("'").V.("'").W THEN START
WHILE V->X.(",").Y CYCLE
V=X."_".Y
REPEAT
S=U."'".V."'".W
FINISH
I=SETPARS(7,S,PAR,KEY)
IF I#0 THEN ERR=I
SSJOBNAME<-PAR(1)
JOBOWNER<-PAR(1)
IF JOBOWNER->(":").T THEN JOBOWNER=T
!*NE JBRJOBNAME=":".JOBOWNER
!*NE ITOE(ADDR(JBRJOBNAME)+1,33)
!*UKC %IF JOBOWNER->T.(".").U %THEN JOBOWNER=T
!*UKC;%IF JOBOWNER->T.(".").U %THEN JOBOWNER=T %ELSE U = ""
!*E; DPRINTSTRING(" JBS ".JNUM." ".JOBOWNER." ".U."
")
%IF JOBOWNER#'' %THEN %START
I=LENGTH(JOBOWNER)
J=CHARNO(JOBOWNER,1)
%UNLESS 'A'<=J<='Z' %THEN ->BADUSER
%CYCLE K=1,1,I
J=CHARNO(JOBOWNER,K)
%UNLESS 'A'<=J<='Z' %OR '0'<=J<='9' %THEN ->BADUSER
%REPEAT
%FINISH %ELSE %START
BADUSER:
!*NE NEWPAGE
!*E; NEWPAGE %UNLESS JOBNUM=0
!*E; SET OUTPUT LIMIT(JOB OUTPUT LIMIT,OUTPUT BREAK)
!*NE %IF JOBNUM<=1 %THEN DATIME(DATE,TIME)
!*UKC; JOBNUM = JOBNUM + 1
!*UKC;DELIVERY = "*** INVALID USERNAME ***"
HEAD(0)
NEWLINES(4)
PRINTSTRING('// JOB('.S.")")
NEWLINES(2)
JOBACTIVE=1
!*UKC JOBNUM=JOBNUM+1
SSERR(201)
%FINISH
%IF PAR(2)#'' %THEN DELIVERY<-PAR(2) %ELSE DELIVERY<-PAR(7)
%IF PAR(3)#'' %THEN T=PAR(3) %ELSE T=PAR(5)
%IF T#'' %THEN %START; ! TIME LIMIT SET
I=STOI(T)
%IF I<0 %THEN %START
ERR1=202
S1=T
%FINISH %ELSE %START
%IF I>MAX CPU LIMIT %C
%THEN ERR1=203 %AND S1='' %AND I=MAXCPULIMIT
%IF I<5 %THEN I=5
JOB CPU LIMIT=I
%FINISH
%FINISH
%IF PAR(4)#'' %THEN T=PAR(4) %ELSE T=PAR(6)
%IF T#'' %THEN %START; ! OUTPUT LIMIT SET
I=STOI(T)
%IF I<0 %THEN %START
ERR2=202
S2=T
%FINISH %ELSE %START
%IF I>MAX OUTPUT LIMIT %C
%THEN ERR2=204 %AND S2='' %AND I=MAX OUTPUT LIMIT
%IF I<200 %THEN I=200
JOB OUTPUT LIMIT=I
%FINISH
%FINISH
JOBACTIVE=1
!*NE %IF JOBNUM=0 %THEN DATIME(DATE,TIME)
JOBNUM=JOBNUM+1
! STRING(COMREG(16)) = JOBOWNER
SET OUTPUT LIMIT(JOB OUTPUT LIMIT,OUTPUT BREAK)
!*NE NEWPAGE
!*E; NEWPAGE %UNLESS JOBNUM=1
HEAD(0)
NEWLINES(4)
PRINTSTRING('// JOB('.S.")")
NEWLINES(2)
JOBSTARTCPU=READ CPU TIME
I=PARM('')
COMREG(28)=0; ! CLEAR SUBSYSTEM FLAGS
I=SET CPU LIMIT(JOB CPU LIMIT*1000)
%IF ERR#0 %THEN SSMESS(ERR)
%IF ERR1#0 %THEN SSMESSA(ERR1,S1)
%IF ERR2#0 %THEN SSMESSA(ERR2,S2)
%END; ! JOB
!*
%STRING(32)%FNSPEC INTTOSTRING(%INTEGER N,MAXL)
!*NE %SYSTEMSTRING(64)%FNSPEC PAD(%STRING(64) S,%INTEGER MAXL)
!!
%ROUTINE ENDJOB
%INTEGER CPU, LINES, TRANSFERS, I
%STRING (10) START
%STRING(255) ACCMESS
START = START TIME
SET OUTPUT LIMIT(1000,0)
CLOSE FILES(0,LINES,TRANSFERS); ! AND CLEAR DESCRIPTORS
JOBACTIVE=0
MONCPU=0
JOBENDCPU=READ CPU TIME
CPU=JOBENDCPU-JOBSTARTCPU
!*NE DATIME(DATE,TIME)
PRINTSTRING('
JOB ENDED AT '.TIME.'
CPU USED:')
PRINT(CPU/1000.0,3,3)
PRINTSTRING(' SECS.
OUTPUT:')
WRITE(LINES,9)
PRINTSTRING(' LINES
')
%IF TRANSFERS#0 %THEN %START
PRINTSTRING('
FILE TRANSFERS:')
WRITE(TRANSFERS,1)
%FINISH
NEWLINES(2)
HEAD(1)
!*UKC NEWPAGE
!****** ACCOUNT
! SIM2(15,1,100,I); ! SELECT LOG
! %IF BYTEINTEGER(ADDR(SSJOBNAME)+1)#':' %THEN %C
! SSJOBNAME=":".SSJOBNAME
! PRINTSTRING("JOB")
! WRITE(JOBNUM,3)
! PRINTSTRING(" JOBNAME: ")
! PRINTSTRING(SSJOBNAME)
! SPACES(33-LENGTH(SSJOBNAME))
! PRINTSTRING("CPU:")
! PRINT(CPU/1000.0,3,2)
! PRINTSTRING(" SECS. LINES:")
! WRITE(LINES,5)
!*NE ACCMESS = "JOB ".INTTOSTRING(JOBNUM,3)." "
! !*NE %WHILE LENGTH(SSJOBNAME)< 32 %THEN SSJOBNAME=SSJOBNAME." "
!*NE ACCMESS=ACCMESS.SSJOBNAME."START: ".START." ". %C
!*NE "CPU:".INTTOSTRING(CPU,7). %C
!*NE " LINES:".INTTOSTRING(LINES,6)
!*NE %IF TRANSFERS#0 %THEN %START
!*NE PRINTSTRING(" FILE TRANSFERS:")
!*NE WRITE(TRANSFERS,3)
!*NE ACCMESS = ACCMESS." FILE TRANSFERS: ".INTTOSTRING(TRANSFERS,6)
!*NE %FINISH
SELECTOUTPUT(99)
JBR ACNT(1,TIME,ACCMESS)
!*E; DPRINTSTRING(" JBE ".JNUM." ".INTTOSTRING(CPU,7)." ". %C
INTTOSTRING(LINES,6)."
")
%END ;! ENDJOB
!*
%EXTERNALSTRING(32)%FN INTTOSTRING(%INTEGER INT,MAXL)
%STRING(32) S
%INTEGER I,J,REM
S=""
J=INT
%CYCLE
I=J//10
REM=J-I*10
S=TOSTRING(REM+'0').S
J=I
%EXIT %IF J=0
%REPEAT
%WHILE LENGTH(S)<MAXL %THEN S = " ".S
%RESULT=S
%END; ! OF INTTOSTRING
!*
!*
%INTEGERFN CREATEF(%STRING (32) NAME, %C
%INTEGER ORG, RECSIZE, BLKSIZE, FILESIZE,RTYPE,FE)
!*NE %LONGINTEGER KK
%INTEGER I, MIN, MAX, INITSIZE
%STRING (32) DESC
!*NE %IF CHARNO(NAME,1)='*' %C
!*NE %THEN %RESULT =CREATE FILE(NAME,"",-1,-1,-1,-1,-1,-1,-1)
!*NE %IF FILESTORE SET=0 %THEN %START
!*NE I=SET DEFAULT FILESTORE(JOBOWNER)
!*NE %IF I>0 %THEN %RESULT =I
!*NE FILESTORE SET=1
!*NE %FINISH
!*NE %IF RECSIZE<=2036 %AND (BLKSIZE<=0 %OR BLKSIZE=2048) %C
!*NE %AND ORG#2 %THEN %START
!*NE DESC=':STD.STDM'
!*NE %FINISH %ELSE %START
%IF ORG=2 %THEN %START; ! DA FILE
%IF BLKSIZE<2048 %THEN BLKSIZE=2048
MIN=RECSIZE
MAX=RECSIZE
RTYPE=1
%FINISH %ELSE %START; ! ORG=0 SEQUENTIAL
MIN=1
MAX=RECSIZE
%IF RTYPE<=0 %THEN RTYPE=2
!*NE %FINISH
!*NE %UNLESS BLKSIZE>=RECSIZE+12 %THEN BLKSIZE=RECSIZE+12
!*E; BLKSIZE=RECSIZE
!*NE %IF OPSYS=1 %THENSTART;! B ONLY
!*NE I=DESCRIBE FILE(NAME,ORG,RTYPE,MIN,MAX,BLKSIZE)
!*NE %IF I>0 %THEN %RESULT =I
!*NE %FINISH
DESC=NAME
%FINISH
%IF FILESIZE<=0 %THEN %START
FILESIZE=DEFAULT FMAX
! KK=0
! I=READ JS VAR('ICL9CEFSIZE',1,ADDR(KK))
! %IF I=0 %AND KK>0 %THEN FILESIZE=KK %ELSE FILESIZE=-1
! %IF BLKSIZE<=2048 %THEN INITSIZE=12 %ELSE INITSIZE=FILESIZE
! PENDING CLEARANCE OF B EXTEND BUG
%FINISH
!*E; INITSIZE=X'40000'
!*NE INITSIZE=FILESIZE
I=CREATE FILE(NAME,DESC,INITSIZE,FILESIZE,-1, %C
RECSIZE,BLKSIZE,RTYPE,FE)
%IF I>0 %THEN %RESULT =I %ELSE %RESULT =0
%END; ! CREATEF
!*
%ROUTINE CLOSE FILES(%INTEGER MODE, %INTEGERNAME LINES, TRANSFERS)
!* MODE 0 CLEAR FDS 1 CLOSE ONLY
%INTEGER I, J, DAFLAG
%RECORDNAME F(NRFDFMT)
%RECORDNAME TC(TCFMT)
DAFLAG=0
%CYCLE I=1,1,98
%IF FDMAP(I)#0 %THEN %START
J=CLOSE(FDMAP(I))
%IF MODE=0 %THEN FDMAP(I)=0 %ELSE %START
F==RECORD(FDMAP(I))
F_STATUS=0
%IF F_FILEORG=2 %THEN DAFLAG=1
%FINISH
%FINISH
%REPEAT
%CYCLE I=101,1,102
J=CLOSE(FDMAP(I))
F==RECORD(FDMAP(I))
F_STATUS=0
%REPEAT
%IF MODE#0 %THEN %START
!*NE %IF DAFLAG=1 %THEN %START
!*NE I=OLD VM OWNER
!*NE VM OWNER SET=0
!*NE %FINISH
%RETURN
%FINISH
J=RESET FDS
!*NE %IF VM OWNER SET#0 %THEN %START
!*NE I=OLD VM OWNER
!*NE VM OWNER SET=0
!*NE %FINISH
!*NE J=RESET SPOOL
TC==RECORD(COMREG(49)); ! TRANSFER COUNT RECORD
LINES=TC_USER PRINT COUNT-TC_PAGE COUNT; ! N.B. PAGE SIZE CREDIT ALLOWED FOR INITIAL NP
TRANSFERS=TC_USER TRANSFER COUNT
TC_TOTAL PRINT COUNT=TC_TOTAL PRINT COUNT+TC_ %C
USER PRINT COUNT
%END; ! CLOSE FILES
!*
!*
%INTEGERFN FILE DEFINITION(%STRING (255) PARAMS)
!*
%INTEGERFNSPEC FORMAT DA
!*
%CONSTSTRING(8)%ARRAY KEY(1:9)='CHANNEL','NAME','ACCESS','STATUS',
'TYPE','RECSIZE','FILESIZE','RTYPE','FE'
%BYTEINTEGERARRAY C(1:80)
%CONSTSTRING(2)%ARRAY RTYPES(1:3)="F","V","VS"
%STRING (63) %ARRAY PAR(1:9)
%STRING (63) S, T
%INTEGER I, J, K, VALID ACT, AFD, START, CUR, ORG, LREC, LFILE
%INTEGER RECNO, BLKS, RECSPERBLK,RTYPE,FE
%RECORDNAME F(NRFDFMT)
!*
I=SETPARS(9,PARAMS,PAR,KEY)
!*
J=STOI(PAR(1)); ! CHANNEL
%UNLESS 0<=J<99 %THEN SSERR(223); ! INVALID DATA SET NUMBER
!*
S=PAR(3); ! ACCESS
%IF S="R" %THEN VALID ACT=X'3D' %ELSE %START
%IF S="" %OR S="W" %THEN VALID ACT=X'3F' %ELSE SSERR(202)
%FINISH
S=PAR(5); ! TYPE
%IF S='DA' %OR S="D" %THEN ORG=2 %ELSE ORG=0
! CREATE IF NEC.
!*
S=PAR(2); ! NAME
%IF S="*" %THEN %START; ! IN-LINE DATA
!*E START=SPOOL FREE
!*E CUR=START
!*E; F==RECORD(FDMAP(108))
!*E; START=F_C2
%CYCLE
!*E %IF CUR+160>SPOOL MAX %THEN SSERR(217)
!*E; SIM2(0,ADDR(C(1)),0,I)
!*E SIM2(0,CUR,0,I)
!*E I=I-1
!*E; %IF C(1)=25 %START
!*E %IF BYTEINTEGER(CUR)=25 %THEN %START; ! END OF FILE
CUR=F_C2
I=NEWDESC(J,1,3,X'D',0,"",AFD)
%IF I#0 %THEN SSERR(I)
F==RECORD(AFD)
F_C0=START
F_C1=START
F_C2=START
F_C3=CUR
!*E SPOOL FREE=CUR
%RESULT =0
%FINISH
!*NE ITOE(CUR,I)
!*E %IF I<80 %THEN FILL(80-I,CUR+I,X'40')
!*E CUR=CUR+80
%REPEAT
%FINISH
%IF S#'' %THEN %START; ! CHECK FOR INTEGER
K=STOI(S)
%IF K>=0 %THEN %START; ! VALID INTEGER
%UNLESS 0<K<=99 %THEN SSERR(202)
I=NEW DESC(J,1,6,VALID ACT,K,'',AFD)
%IF I#0 %THEN SSERR(I)
%RESULT =0
%FINISH
%FINISH
! %FINISH %ELSE SSERR(220)
%UNLESS JOBBER FACILITY LEVEL>1 %THEN SSERR(230)
T=PAR(6); ! RECSIZE
LREC=STOI(T)
%UNLESS LREC>=0 %THEN SSERR(202)
!*E; LREC=1024 %IF LREC=0 ;! INSTALLATION DEFAULT
T=PAR(7); ! FILESIZE
LFILE=STOI(T); ! IN K BYTES
%IF LFILE<0 %THEN %START
%IF T->T.("R") %THEN %START
LFILE=STOI(T)
%UNLESS LFILE>0 %AND LREC>0 %THEN SSERR(202)
RECNO = LFILE
!*NE %IF LREC <= 2036 %THEN %START
!*NE RECSPERBLK = 2048//(LREC+12) ;! NO OF RECS THAT FIT
!*NE ! INTO 1 BLK OF LINKED
!*NE ! SUBTRACK FILE
!*NE BLKS = (LFILE + RECSPERBLK - 1) // RECSPERBLK
!*NE LFILE = BLKS * 2; ! SIZE OF FILE IN K
!*NE %FINISH %ELSE %START
!*NE LFILE=(LFILE*(LREC+12)+1023)>>10;! UPPER BOUND
!*NE %FINISH
!*E; LFILE=LREC*(RECNO+2) ;! ALLOW ROOM FOR V CASE
%FINISH %ELSE SSERR(202)
%FINISH %ELSE RECNO = 0
!*E; %UNLESS S="" %THEN S=JOBOWNER.".".S
%IF LENGTH(S)>32 %THEN SSERR(167);! INVALID PARAMETER
I=NEW DESC(J,1,4,VALID ACT,1,S,AFD)
%IF I#0 %THEN SSERR(I)
%IF S='' %THEN %RESULT =0; ! TEMPORARY FILE
F==RECORD(AFD)
I=GET ROUTE(AFD)
%IF I#0 %THEN %START
%IF I=152 %THEN %START
I=218
%IF PAR(4)='OLD' %THEN SSERR(218)
%IF ORG=2 %THEN %START
%UNLESS LFILE>0 %AND LREC>0 %THEN SSERR(202)
%FINISH
%FINISH
%IF I=218 %AND VALID ACT&2#0 %THEN %START
! DOES NOT EXIST AND WRITE
RTYPE=-1
FE=-1
T=PAR(8);! RTYPE
%IF T#'' %THENSTART
%CYCLE I=1,1,3
%IF T=RTYPES(I) %THEN RTYPE=I
%REPEAT
%FINISH
T=PAR(9);! FE
%IF T#'' %THENSTART
I=STOI(T)
%IF 0<=I<=2 %THEN FE=I
%FINISH
I=CREATEF(F_IDEN,ORG,LREC,0,LFILE,RTYPE,FE)
%IF I#0 %THEN SSERR(I)
%IF ORG=2 %THEN %START
I=FORMAT DA
%IF I>0 %THEN SSERR(I) %ELSE %RESULT =0
%FINISH
%FINISH %ELSE SSERR(I)
!*NE I=CLOSE FILE(F_ROUTECCY,0); ! TO DEASSIGN ON K
%FINISH %ELSE %START
%IF PAR(4)='NEW' %THEN SSERR(219)
%FINISH
%RESULT =0
!*
%INTEGERFN FORMAT DA
%INTEGER I, J, COUNT, SIZE, BOUND
BOUND=LFILE<<10; ! IN BYTES
SIZE=LREC+12
F_MODE=5; ! WRITE FORWARDS,FIXED
I=OPEN(AFD,2)
%IF I>0 %THEN %RESULT =I
FILL(F_MAXREC,F_AREC,X'40')
COUNT=0
J=ADDR(F_C0)
WRITE:I=FASTFILEOP(J)
%IF I>0 %THEN %START
SSERR(I)
STOP: I=CLOSE(AFD)
F_MODE=11
%IF COUNT>0 %THEN %START
NEWLINE
WRITE(COUNT,1)
PRINTSTRING(' RECORDS FORMATTED
')
%FINISH
%RESULT =0
%FINISH
COUNT=COUNT+1
SIZE=SIZE+F_MAXREC
%IF COUNT = RECNO %OR SIZE>BOUND %THEN ->STOP; ! TO PREVENT PROG
! RUNNING AWAY
->WRITE
%END; ! FORMAT DA
!*
%END; ! FILE DEFINITION
!*
!*
!*E; %SYSTEMINTEGERFN GET ROUTE(%INTEGER AFD)
!*NE %INTEGERFN GET ROUTE(%INTEGER AFD)
%RECORDNAME F(NRFDFMT)
%INTEGER I, J, K, FILEORG, DEVCLASS, RECTYPE, FE, MINREC, MAXREC
!*NE %STRING (63) S, T
!*NE %LONGINTEGER KK
F==RECORD(AFD)
!*NE %IF VM OWNER SET<=0 %AND F_ACCESS ROUTE=4 %THEN %START
!*NE %IF VM OWNER SET<0 %THEN %START
!*NE %IF CHARNO(F_IDEN,1)='*' %THEN ->LIBONLY %C
!*NE %ELSE SSERR(216)
!*NE %FINISH
!*NE I=NEW VM OWNER(JOBOWNER)
!*NE %IF I#0 %THEN %START
!*NE %IF CHARNO(F_IDEN,1)='*' %THEN %START
!*NE I=NEW VM OWNER('')
!*NE VM OWNER SET=-1
!*NE %FINISH %ELSE SSERR(216)
!*NE %FINISH %ELSE VM OWNER SET=1
!*NE %FINISH
!*NE LIBONLY:
%IF F_ACCESS ROUTE=1 %THEN %START
J=1
K=1; ! READ ACCESS ONLY
%FINISH %ELSE %START
K=2; ! READ/WRITE ACCESS
%IF F_ACCESS ROUTE=2 %THEN J=2 %ELSE J=0
%FINISH
%IF F_ACCESS ROUTE=4 %AND F_IDEN='' %THEN %START
! TEMPORARY FILE
! %IF OPSYS=2 %THEN %RESULT =220; ! TEMP ON K
!*NE I=WORK FILE(':STD.STDM',-1,-1,-1,F_ROUTECCY,FILEORG, %C
DEVCLASS,RECTYPE,FE,MINREC,MAXREC)
!*E; MAXREC=AFD
!*E; I=WORKFILE("",-1,-1,-1,F_ROUTECCY,FILEORG, %C
DEVCLASS,RECTYPE,FE,MINREC,MAXREC)
%IF I>0 %THEN %RESULT =I
->SETFD
%FINISH
I=DEFINE FILE(J,K,F_IDEN,F_ROUTECCY,FILEORG,DEVCLASS, %C
RECTYPE,FE,MINREC,MAXREC)
%IF I>0 %THEN %RESULT =I
!*NE LIB: %IF F_IDEN->('*').S.(".").T %THEN %START; ! LIBRARY FILE
!*NE %IF OPSYS=2 %THEN %RESULT =220;! ON K ONLY
!*NE I=READ JS VAR(S,1,ADDR(KK))
!*NE %IF I#0 %THEN %RESULT =221
!*NE J=KK
!*NE RFD: I=READ FILE DESCRIPTION(J,FILEORG,DEVCLASS,RECTYPE, %C
!*NE MINREC,MAXREC)
!*NE %IF I>0 %THEN %RESULT =I
!*NE %FINISH
SETFD:F_STATUS=1
F_DEV CLASS=DEVCLASS
%IF RECTYPE = 1 %THEN %START ;! FIXED LENGTH RECS
%IF F_MODE = 11 %OR F_MODE = 9 %OR F_MODE = 6 %OR F_MODE = 2 %C
%THEN F_MODE = F_MODE - 1
%FINISH
%IF F_DEVCLASS=9 %THEN F_MODE=0; ! CONTROL STREAM
F_FILEORG=FILEORG
F_REC TYPE=RECTYPE
! PROCESS FORMAT EFFECTORS
F_MINREC=MINREC
F_MAXREC=MAXREC
F_RECSIZE=MAXREC
%RESULT =0
%END; ! GET ROUTE
!*
!*
%INTEGERFN CHECKLNAME(%STRINGNAME IDEN)
%STRING (63) S, T
%IF JOBBER FACILITY LEVEL<=1 %THEN %RESULT =230
!*NE %IF IDEN->('*').T %THEN %START
!*NE %UNLESS OPSYS=1 %THEN %RESULT =220;! ON K ONLY
!*NE %UNLESS T->S.(".").T %THEN SSERR(220)
!*NE %IF T='' %THEN SSERR(220); ! INVALID FILE NAME
!*NE %FINISH
!*E; %UNLESS IDEN->T.(".").S %THEN IDEN=JOBOWNER.".".IDEN
%IF LENGTH(IDEN)>32 %THEN SSERR(224)
%RESULT =0
%END; ! CHECKLNAME
!*
%INTEGERFN INFILE2(%STRING (63) IDEN)
%INTEGER I, AFD
%RECORDNAME F(NRFDFMT)
I=CHECKLNAME(IDEN)
%IF I>0 %THEN %RESULT =I
I=NEWDESC(101,1,4,1,0,IDEN,AFD)
%IF I>0 %THEN %RESULT =I
F==RECORD(AFD)
F_MODE=2; ! ALLOW STDTXT INPUT
I=GET ROUTE(AFD)
%IF I=152 %THEN I=218
%RESULT =I
%END; ! OF INFILE2
!*
!*
%INTEGERFN OUTFILE2(%STRING (63) IDEN, %INTEGER MODE)
!" MODE =0 FILE MAY EXIST ALREADY
!* MODE =1 FILE MUST BE NEW
INTEGER I, AFD
!*E; I=CHECKLNAME(IDEN)
I=NEW DESC(102,1,4,2,0,IDEN,AFD)
IF I>0 THEN RESULT =I
I=GET ROUTE(AFD)
IF I=152 THEN I=218
IF I>0 THEN RESULT =I
IF MODE=1 THEN RESULT =219; ! FILE ALREADY EXISTS
RESULT =0
END ; ! OF OUTFILE2
!*
ROUTINE COMP(INTEGER C, STRING (255) S, INTEGER NEWP)
CONSTSTRING (7)ARRAY KEY(1:2)='INPUT','OPTIONS'
STRING (63) ARRAY PAR(1:2)
INTEGER I, J
I=0
IF S#0 THEN START
J=SETPARS(2,S,PAR,KEY)
IF J#0 THEN SSERR(J)
IF PAR(1)#'' THEN START ; ! USER FILE SPECIFIED
J=INFILE2(PAR(1))
IF J>0 THEN SSMESS(J) AND RETURN
I=1
FINISH
FINISH
J=COMPILE(C,I,NEWP)
SSMESS(J) UNLESS J=0
END ; ! COMP
!*
INTEGERFN INPUTF(STRING (255) PARAMS)
CONSTSTRING (5)ARRAY KEY(1:2)='NAME','DUMMY'
STRING (63) ARRAY PAR(1:2)
INTEGER I, J, K, LEN, FLAG, COUNT
BYTEINTEGERARRAY CHS(0:160)
I=SETPARS(1,PARAMS,PAR,KEY)
PARAMS=PAR(1)
I=CHECKLNAME(PARAMS)
IF I>0 THEN RESULT =I
I=OUTFILE2(PARAMS,1)
!*E; %IF I=218 %OR I=219 %START
!*NE %IF I=218 %THEN %START
I=CREATEF(PARAMS,0,80,-1,0,2,1)
IF I#0 THEN RESULT =I
FINISH ELSE RESULT =I
SELECTOUTPUT(102)
J=ADDR(CHS(0))
K=ADDR(CHS(1))
CHS(0)=10
COUNT=0
C8: SIM2(0,K,0,LEN)
IF CHS(1)=25 OR (CHS(1)='/' AND CHS(2)='/') THEN START
SELECT OUTPUT(99)
NEWLINE
WRITE(COUNT,1)
PRINTSTRING(' RECORDS WRITTEN TO FILE
')
RESULT =0
FINISH
SIM2(1,J,LEN,FLAG)
COUNT=COUNT+1
->C8
END ; ! INPUTF
!*
INTEGERFN LISTF(STRING (255) PARAMS)
CONSTSTRING (5)ARRAY KEY(1:2)='NAME','DUMMY'
STRING (63) ARRAY PAR(1:2)
INTEGER I, J, K, LEN, FLAG
BYTEINTEGERARRAY CHS(0:160)
I=SETPARS(1,PARAMS,PAR,KEY)
I=INFILE2(PAR(1))
IF I>0 THEN RESULT =I
SELECTINPUT(101)
J=ADDR(CHS(0))
K=ADDR(CHS(1))
CHS(0)=10
C13: SIM2(0,K,0,LEN)
IF CHS(1)=25 THEN RESULT =0
SIM2(1,J,LEN,FLAG)
->C13
END ; ! LISTF
!*
INTEGERFN EDITCHECK(STRING (255) PARAMS)
INTEGER I
STRING (255) INF, OUTF, S
CONSTSTRING (7)ARRAY KEY(1:2)='OLDFILE','NEWFILE'
STRING (63) ARRAY PAR(1:2)
I=SETPARS(2,PARAMS,PAR,KEY)
INF=PAR(1)
OUTF=PAR(2)
IF INF='' OR OUTF='' THEN RESULT =202
I = INFILE2(INF)
IF I > 0 THEN RESULT = I
I=CHECKLNAME(OUTF)
IF I>0 THEN RESULT =I
I=OUTFILE2(OUTF,0)
IF I=218 THEN START
I=CREATEF(OUTF,0,132,-1,0,2,1)
IF I#0 THEN RESULT =I
FINISH ELSE START
IF I>0 THEN RESULT =I
FINISH
RESULT =I
END ; ! EDITCHECK
!*
! %INTEGERFN AMENDCHECK(%STRING (255) PARAMS, %INTEGERNAME INPUT SET)
! !%INTEGER I
! !%STRING (255) INF, OUTF, S
! !%CONSTSTRING(6)%ARRAY KEY(1:2)='INPUT','OUTPUT'
! !%STRING (63) %ARRAY PAR(1:2)
! ! I=SETPARS(2,PARAMS,PAR,KEY)
! ! INF = PAR(1)
! ! %IF INF = '' %THEN INPUT SET = 0 %ELSE %C
! ! INPUT SET = 1 %AND I = INFILE2(INF)
! ! %IF I > 0 %THEN %RESULT = I
! ! OUTF=PAR(2)
! ! %IF OUTF='' %THEN %RESULT =202
! ! %IF PAR(1)=PAR(2) %THEN %RESULT=229
! ! I=CHECKLNAME(OUTF)
! ! %IF I>0 %THEN %RESULT =I
! ! I=OUTFILE2(OUTF,0)
! ! %IF I=218 %THEN %START
! ! I=CREATEF(OUTF,0,132,-1,0,2,1)
! ! %IF I#0 %THEN %RESULT =I
! ! %FINISH %ELSE %START
! ! %IF I>0 %THEN %RESULT =I
! ! %FINISH
! ! %RESULT =I
! %END; ! AMENDCHECK
! !*
INTEGERFN DELETEF(STRING (255) PARAMS)
CONSTSTRING (5)ARRAY KEY(1:2)='NAME','DUMMY'
STRING (63) ARRAY PAR(1:2)
!*E; %INTEGER I
!*NE %INTEGER I, CUR, ORG, DCLASS, DTYPE, FE, MIN, MAX
!*NE %CONSTINTEGER TEMPNODE = 300, %C
NOTEXIST = 152
I=SETPARS(1,PARAMS,PAR,KEY)
I=CHECKLNAME(PAR(1))
IF I>0 THEN RESULT =I
!*NE %IF VM OWNER SET<=0 %THEN %START
!*NE %IF VM OWNER SET<0 %THEN %START
!*NE %IF CHARNO(PAR(1),1)='*' %THEN ->LIBONLY %C
!*NE %ELSE SSERR(216)
!*NE %FINISH
!*NE I=NEW VM OWNER(JOBOWNER)
!*NE %IF I#0 %THEN %START
!*NE %IF CHARNO(PAR(1),1)='*' %THEN %START
!*NE I=NEW VM OWNER('')
!*NE VM OWNER SET=-1
!*NE %FINISH %ELSE SSERR(216)
!*NE %FINISH %ELSE VM OWNER SET=1
!*NE %FINISH
! CUR=CHECK CUR(PAR(1),0,1)
! %IF CUR#0 %THEN ->DEL
!*NE LIBONLY:
! I=DEFINE FILE(0,2,PAR(1),CUR,ORG,DCLASS,DTYPE,FE,MIN,MAX)
! %IF I=152 %THEN I=218
! COMMAND LEVEL MESSAGE
! %IF I>0 %THEN %RESULT=I
!*NE DEL: I=DELETE FILE(PAR(1))
!*NE %IF I = TEMPNODE %THEN I = 0
!*NE %IF I = NOTEXIST %THEN I = 218
!*E; DESTROYFILE(PAR(1) ,I)
!*NE %IF I<=0 %THEN %START
!*NE FILESTORE SET=0
!*NE I=OLD VM OWNER
!*NE VM OWNER SET=0
!*NE %RESULT =0
!*NE %FINISH %ELSE %RESULT =I
!*E; %RESULT=I
END ; ! DELETEF
!*
!*
ENDOFFILE