!* !* !*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) NEWPAGE 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) IF JOBOWNER->T.(".").U THEN JOBOWNER=T !*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) HEAD(0) NEWLINES(4) PRINTSTRING('// JOB('.S.")") NEWLINES(2) JOBACTIVE=1 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) 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