EXTERNALROUTINESPEC DPRINTSTRING(STRING (255) S)
SYSTEMROUTINESPEC PHEX(INTEGER N)
OWNINTEGER PFLAG
!*
!*
EXTERNALINTEGER SSARRAYDIAG = 40
EXTERNALINTEGER OPEHMODE = 0
EXTERNALINTEGER BATCH OPTIONS
EXTERNALINTEGER JDEFADDR
EXTRINSICSTRING (6) SSOWNER; ! PROCESS NAME
!!
!****** SYSTEM ROUTINE REFERENCES TO SUBSYSTEM
!*
SYSTEMROUTINESPEC ONTRAPE(INTEGER CLASS, SUBCLASS)
EXTERNALROUTINESPEC DRESUME(INTEGER A, B, C)
SYSTEMINTEGERFNSPEC PRIME CONTINGENCY(ROUTINE ONPROC)
EXTERNALSTRING (32) FNSPEC INTTOSTRING(INTEGER INT, MAXL)
SYSTEMSTRING (6) FNSPEC RELEASE
ROUTINESPEC STOP BASE
CONSTSTRING (8) NAME DATE = X'80C0003F'
CONSTSTRING (8) NAME TIME = X'80C0004B'
EXTERNALINTEGERFNSPEC DPON2(STRING (6) USER, C
RECORDNAME P, INTEGER MSGTYPE, OUTNO)
SYSTEMROUTINESPEC SENDFILE(STRING (32) FILE, C
STRING (8) DEVICE, INTEGER COPIES, FORMS, C
INTEGERNAME FLAG)
EXTERNALINTEGERFNSPEC DFINFO(STRING (6) USER, STRING (11) FILE C
INTEGER FSYS,ADR)
SYSTEMROUTINESPEC FINFO(STRING (31) FILE, INTEGER MODE, C
RECORDNAME R, INTEGERNAME FLAG)
SYSTEMINTEGERMAPSPEC FDMAP(INTEGER STREAM)
SYSTEMINTEGERMAPSPEC COMREG(INTEGER N)
SYSTEMROUTINESPEC MOVE(INTEGER L, F, T)
SYSTEMROUTINESPEC PERMIT(STRING (31) FILE, C
STRING (6) USER, INTEGER MODE, INTEGERNAME FLAG)
EXTERNALINTEGERFNSPEC DCONNECT(STRING (6) USER, C
STRING (11) FILE, INTEGER FSYS, MODE, APF, C
INTEGERNAME SEQ, GAP)
EXTERNALINTEGERFNSPEC DPERMISSION( C
STRING (6) OWNER, USER, STRING (8) DATE, C
STRING (11) FILE, INTEGER FSYS, TYPE, ADPRM)
EXTERNALINTEGERFNSPEC DCREATE(STRING (6) USER, C
STRING (11) FILE, INTEGER FSYS, TYPE, NKB)
SYSTEMROUTINESPEC CONNECT(STRING (31) FILE, C
INTEGER MODE, HOLE, PROTECT, RECORDNAME R, C
INTEGERNAME FLAG)
SYSTEMROUTINESPEC SDISCONNECT(STRING (31) FILE, C
INTEGER FSYS, INTEGERNAME FLAG)
SYSTEMROUTINESPEC DISCONNECT(STRING (31) FILE, INTEGERNAME FLAG)
SYSTEMROUTINESPEC CHANGEFILESIZE(STRING (31) S, C
INTEGER NEW SIZE, INTEGERNAME FLAG)
SYSTEMROUTINESPEC DESTROY(STRING (31) FILE, INTEGERNAME FLAG)
SYSTEMROUTINESPEC OUTFILE(STRING (31) FILE, C
INTEGER SIZE, HOLE, PROTECTION, INTEGERNAME CONAD, FLAG)
SYSTEMROUTINESPEC SSMESS(INTEGER N)
! %SYSTEMROUTINESPEC CHANGE ACCESS(%STRING (31) S, %C
! %INTEGER NEW ACCESS, %INTEGERNAME FLAG)
!*
!****** MAIN
!*
EXTERNALINTEGERFNSPEC ICL9CESUBS(INTEGER ENTRY)
!*
!*
OWNINTEGER ENDLESS = 0; ! GIVE INFINITE LOOP WHEN REQD.
OWNINTEGER SENSITIVE = 0
OWNINTEGER KEEPLNB; ! RETURN LNB FOR SUBSYSTEM CONTROL
OWNINTEGER KEEP2LNB; ! RETURN LNB FOR JBR CONTROL RT.
OWNINTEGER FLAG
OWNSTRING (10) INPUTF
OWNSTRING (31) INPUT = "", OUTPUT; !PRIMARY INPUT AND OUTPUT FILE NAMES
OWNSTRING (6) SPOOLER = "SPOOLR"
OWNSTRING (15) OUTPUTQ = "LPJBR"
OWNINTEGER INPUTFSYS
OWNINTEGER BCPUTIME; ! JCL BATCH TIME
!!
CONSTINTEGER TEMPORARY = X'40000000'
CONSTINTEGER EIGHTSEGMENTS = X'200000'
CONSTINTEGER FIXED = 1, VARIABLE = 2
CONSTINTEGER DATAFILE = 4, SERIAL = 0, DA = 2
EXTRINSICINTEGER DEFAULT FMAX
OWNSTRING (8) SJVERSION = ' E.15 '
!*
ROUTINESPEC SUPERSTOP
!*
RECORDFORMAT NRFDFMT(INTEGER LINK, DSNUM, C
BYTEINTEGER STATUS, ACCESS ROUTE, VALID ACTION, CUR STATE, C
BYTEINTEGER MODE OF USE, MODE, FILE ORG, DEV CLASS, C
BYTEINTEGER RECTYPE, FLAGS, LM, RM, C
INTEGER ASVAR, AREC, RECSIZE, MINREC, MAXREC, MAXSIZE, C
ROUTECCY, INTEGER C0, C1, C2, C3, C
INTEGER TRANSFERS, DARECNUM, LASTREC, RECORDS, C
STRING (31) IDEN)
RECORDFORMAT RF(INTEGER CONAD, FILETYPE, DATASTART, DATAEND, C
SIZE, RUP, EEP, MODE, USERS, ARCH, C
STRING (6) TRAN, STRING (8) DATE, TIME, C
INTEGER COUNT1, SPARE1, SPARE2)
RECORDFORMAT FRECFMT(INTEGER NKB, RUP, EEP, APF, USE, ARCH, C
FSYS, CONSEG, CCT, CODES, CODES2, SSBYTE, STRING (6) OFFER)
RECORDFORMAT HEADFMT(INTEGER DATAEND, DATASTART, SIZE, FILETYPE, C
DATE, TIME, FORMAT, RECORDS)
RECORDFORMAT PF(INTEGER DEST, SRCE, STRING (23) MESS)
RECORDFORMAT REQF(INTEGER DEST, SRCE, FLAG, C
STRING (6) USER, FILE, INTEGER P6)
RECORDFORMAT REPF(INTEGER DEST, SRCE, FLAG, C
STRING (6) FILE, STRING (11) OUTPUTQ)
RECORDFORMAT REP2F(INTEGER DEST, SRCE, C
BYTEINTEGER FLAG, STRING (6) FILE, STRING (15) OUTPUTQ)
!*
!*
!* BASE ROUTINES FOR JOBBER ON EMAS
!*
!*
!* RESULT=0 MEANS OK
!!
CONSTBYTEINTEGERARRAY H(0 : 15) = C
'0','1','2','3','4','5','6','7','8','9',
'A','B','C','D','E','F'
!!
EXTERNALINTEGER RLEVEL = 4
SYSTEMROUTINE REPORT(STRING (48) S)
INTEGER OUTPUTSTREAM
IF RLEVEL < 3 THEN RETURN
OUTPUT STREAM = COMREG(23)
SELECT OUTPUT(100) UNLESS OUTPUT STREAM = 100
PRINTSTRING(" >> EMAS BASE << ".S)
NEWLINE
SELECTOUTPUT(OUTPUTSTREAM) UNLESS COMREG(23) = 100
END
!!
SYSTEMROUTINE POST REPORT(STRING (48) S, INTEGER N)
PRINTSTRING(" >>EMAS BASE<< HAVE CALLED ".S." VALUE ")
WRITE(N,1)
NEWLINE
END
! %STRING (32) %FN UNIQUE NAME
! !! FILE NAMES GENERATED BY THE JOBBER MUST BE UNIQUE SO USE
! !! DATE, TIME AND AN INCREMENTING SUFFIX.
! %STRING (32) S
! %OWNBYTEINTEGER SUFFIX = '@'
! SUFFIX = SUFFIX+1
! %IF SUFFIX > 'Z' %THEN SUFFIX = 'A'
! S = DATE.TIME." "
! BYTEINTEGER(ADDR(S)+LENGTH(S)) = SUFFIX
! %RESULT = S
! %END
! OF UNIQUE NAME
!!
! !!**********************************************************
!!
!! LOG
!!
!!*************************************************************
!*
SYSTEMROUTINE LOG(INTEGER MSG ADDR, MSG LENGTH)
!!
!!
STRING (255) S
IF MSG LENGTH <= 0 THEN RETURN
IF MSG LENGTH > 254 THEN MSG LENGTH = 254
MOVE(MSG LENGTH,MSG ADDR,ADDR(S)+1)
LENGTH(S)=MSG LENGTH
S = S."
"
DPRINTSTRING(S)
!!
END ; ! OF LOG
! !*
SYSTEMROUTINE DATE AND TIME(STRINGNAME D, T)
D = DATE
T = TIME
END
!*
SYSTEMINTEGERFN WRITE JS VAR(STRING (31) NAME, C
INTEGER OPTION, AD)
! DUMMY NO JOB SPACE VARIABLES ON EMAS
RESULT = 1
END ; !WRITE JS VAR
!*
!*
! %SYSTEMINTEGERFN INITBASE(%INTEGER MODE, %STRING (63) S)
! %INTEGER I
! LOG(ADDR(S)+1,LENGTH(S))
! %RESULT = 0
! %END
!INITBASE
!*
ROUTINE EMASJBR
INTEGER I
*STLN_KEEP2LNB
! REMEMBER WAY BACK TO JBRCONTROL
I = ICL9CESUBS(0)
! NOTE: JBR ENTRY CALLED DIRECT, COMPILERS LOADED WHEN NEEDED
END ; !EMASJBR
!*
!*
SYSTEMROUTINE OPEHUSERERROR
END
SYSTEMROUTINE REMOVE AREA(STRINGNAME S)
INTEGER FLAG
DESTROY(S,FLAG)
END
!*
OWNSTRING (8) START TIME
!*NE %OWNSTRING(10) DATE,TIMEDATE,TIME
!*
! HEAD
!*
!*
!*
!**************************************************
!*
!* JOBBER ACCOUNTING PROCEDURE
!*
!***************************************************
!*
SYSTEMROUTINE JBR ACNT(INTEGER EP, STRING (8) TIME, C
STRING (255) TEXT)
END
!*
!*
!*
!!
!!******************************************************
!!
!! WORK FILE
!!
!!*******************************************************
!!
SYSTEMINTEGERFN WORK FILE(STRING (32) DESC, C
INTEGER INIT, MAX, EXT, C
INTEGERNAME CURRENCY, FILE ORG, DEVCLASS, RECTYPE, FE, C
MINREC, MAXREC)
RECORDNAME F(NRFDFMT)
INTEGER CONAD
STRING (6) S
STRING (2) A, B, C
RECORDNAME HEADER(HEADFMT)
!*
F == RECORD(MAXREC); ! FUDGE
IF MAX = -1 THEN MAX = DEFAULT FMAX ELSE MAX = MAX*1024
TIME -> A.(".").B.(".").C
S = A.B.C
F_IDEN = "W".S
OUTFILE(F_IDEN,MAX//1024,0,X'40000000',CONAD,FLAG)
IF FLAG # 0 THEN RESULT = FLAG
HEADER == RECORD(CONAD)
HEADER_DATASTART = 32
HEADER_DATAEND = 32
RECTYPE = VARIABLE UNLESS 0 <= RECTYPE <= 3
MAXREC = X'1000' UNLESS MAXREC > 0
HEADER_FORMAT = (MAXREC<<16)!RECTYPE
HEADER_FILETYPE = DATAFILE; ! DATA UNTIL PROVEN OTHERWISE
FILEORG = 0
MINREC = 0
MAXREC = 0
DEVCLASS = 1
RESULT = FLAG
END ; !WORK FILE
!*
!*
!****************************************************
!*
!* CHECK USER INDEX IS WRITE PERMITTED
!*
!**************************************************
!*
INTEGERFN CHECK INDEX(STRING (32) NAME)
!!
RECORDFORMAT USERPERMFM(STRING (6) USER, BYTEINTEGER UPRM)
RECORDFORMAT INDEX LIST FM( C
INTEGER BYTES RETURNED, OWNP, EEP, SPARE, C
RECORDARRAY INDIV PRM(0 : 15)(USER PERM FM))
RECORD INDEX LIST(INDEX LIST FM)
INTEGER I
STRING (32) OWNER, FILE
STRING (6) S, T
IF NAME -> OWNER.(".").FILE THEN START
INDEXLIST = 0
FLAG = DPERMISSION(OWNER,SSOWNER,DATE,FILE,-1,8,ADDR( C
INDEX LIST))
IF FLAG # 0 THEN RESULT = FLAG
CYCLE I = 0,1,15
RESULT = 303 IF ADDR(INDEX LIST_INDIV PRM(I))-ADDR( C
INDEX LIST) > INDEXLIST_BYTES RETURNED
S = SSOWNER
T = INDEXLIST_INDIV PRM(I)_USER
WHILE T -> T.("?") THEN LENGTH(S) = LENGTH(S)-1
LENGTH(S) = LENGTH(T)
IF S = T START
RESULT = 303 UNLESS INDEXLIST_INDIV PRM(I)_UPRM&2 # C
0
-> OK TO CREATE
FINISH
REPEAT
RESULT = 303
FINISH
OK TO CREATE:
RESULT = 0
END
!*
!*
!*******************************************************
!*
!* DESTROY FILE
!*
!*******************************************************
!*
SYSTEMROUTINE DESTROY FILE(STRING (31) FILE, C
INTEGERNAME FLAG)
SYSTEMROUTINESPEC DESTROY(STRING (31) FILE, INTEGERNAME FLAG)
FLAG = CHECK INDEX(FILE)
IF FLAG = 0 THEN DESTROY(FILE,FLAG)
END
!*
!**********************************************************
!*
!* CREATE FILE
!*
!****************************************************
!*
SYSTEMINTEGERFN CREATE FILE(STRING (32) NAME, DESC, C
INTEGER INIT, MAX, EXT, RECSIZE, BLKSIZE, RTYPE, FE)
RECORDNAME HEADER(HEADFMT)
INTEGER CONAD, FSYS, GAP
INTEGER FLAG
!*
IF MAX = -1 THEN MAX = DEFAULT FMAX ELSE MAX = MAX*1024
FLAG = CHECK INDEX(NAME)
RESULT = FLAG UNLESS FLAG = 0
OUTFILE(NAME,MAX//1024,0,0,CONAD,FLAG)
IF FLAG = 218 THEN FLAG = 0
RESULT = FLAG IF FLAG # 0 AND FLAG # 219
! SET UP HEADER IF DATA FILE
HEADER == RECORD(CONAD)
HEADER_DATASTART = 32
HEADER_DATAEND = 32
HEADER_SIZE = MAX
! SET BLKSIZE IF PARAMS LOOK OK
RTYPE = VARIABLE UNLESS 0 <= RTYPE <= 3
BLKSIZE = X'1000' UNLESS BLKSIZE > 0
HEADER_FORMAT = (BLKSIZE<<16)!RTYPE
HEADER_FILETYPE = 4; ! DATA UNTIL PROVEN OTHERWISE
RESULT = FLAG
END ; !CREATE FILE
!*
!!
!!***************************************************************
!!
!! DEFINE FILE
!!
!!*******************************************************
!!
SYSTEMINTEGERFN DEFINE FILE( C
INTEGER DEFINETYPE, PERMISSION, STRING (42) IDEN, C
INTEGERNAME AFD, FILE ORG, DEVCLASS, RECTYPE, C
FORMAT EFFECTORS, MINREC, MAXREC)
RECORDNAME FD(NRFDFMT)
RECORDNAME HEADER(HEADFMT)
RECORD FREC(FRECFMT)
RECORD R(RF)
STRING (42) FILE, USER
INTEGER FSYS, ADR
CONSTINTEGER NONE = 1, NLINE = 0, READWRITE = 2, MAGNETIC = 1
SWITCH TYPE(0 : 3)
INTEGER CONAD, I
!*
UNLESS 0 <= DEFINE TYPE <= 3 THEN RESULT = 1
FD == RECORD(AFD); ! AFD SHOULD BE INTEGER NOT INTEGERNAME
DEVCLASS = MAGNETIC; ! ALL EMAS FILES MAGNETIC
-> TYPE(DEFINE TYPE)
!!
TYPE(1):
! JOB CONTROL STREAM - 108
IDEN = INPUT; ! NAME SET OUTSIDE JOBBER
FD_IDEN = INPUT; ! AND REMEMBER IT
-> SETDTLS
!!
!!
TYPE(2):
! %IF PRIMARY OUTPUT THEN FILE NAME SET OUTSIDE JOBBER
IF FD_DSNUM = 99 START
IDEN = OUTPUT
FD_IDEN = OUTPUT
!! CHECK FIRST TO SEE IF THERE IS A PRINT FILE LEFT AROUND FROM
!! A PREVIOUS RUN.
PREV:
FINFO(IDEN,1,R,FLAG)
IF FLAG = 0 START
CHANGEFILESIZE(IDEN,INTEGER(R_CONAD),FLAG)
IF FLAG # 0 THEN START
PRINTSTRING("
CHANGEFILESIZE ON ".IDEN. C
" FAILS, FLAG = ")
WRITE(FLAG,1)
NEWLINE
FINISH
SENDFILE(IDEN,".".OUTPUTQ,0,0,FLAG)
FINISH
FINISH
SETDTLS:
FILEORG = SERIAL
RECTYPE = FIXED
MINREC = 0; ! SET BY OPEN
MAXREC = 0; ! SET BY OPEN
FD_MODE = 1; ! TEMPORARY
-> FE
!!
TYPE(0):
! A REAL FILE IS REQUIRED - FIND OUT ABOUT IT
FINFO(IDEN,1,R,FLAG)
RESULT = FLAG IF FLAG # 0
HEADER == RECORD(R_CONAD)
FILEORG = SERIAL
RECTYPE = HEADER_FORMAT&7
IF RECTYPE = 0 THEN RECTYPE = FIXED
MAXREC = HEADER_FORMAT>>16
IF RECTYPE = FIXED THEN MINREC = MAXREC ELSE MINREC = 3
!!
!! CHECK ACCESS PERMISSIONS
! WE KNOW THERE IS READ PERMISSION BECAUSE THE FINFO WORKED
IF PERMISSION = READWRITE AND FLAG = 0 AND FD_MODE # 2 START
! CHECK WRITE PERMISSION
RESULT = 162 UNLESS R_RUP&2 # 0;! NO WRITE PERM.
FINISH
!!
FE: IF DEFINE TYPE = 2 THEN FORMAT EFFECTORS = NONE C
ELSE FORMAT EFFECTORS = NLINE
! NLINE MEANS A NL CHARACTER
! EVERY FILE OP.
RESULT = 0
TYPE(3):
! JOURNAL - NO LONGER USED
END ; !DEFINE FILE
!*
!*
!***************************************************
!*
!* EXPAND PRIMARY OUTPUT FILE
!*
!************************************************
!*
SYSTEMROUTINE EXPAND PRIMARY OUTPUT FILE(RECORDNAME F)
RECORDSPEC F(NRFDFMT)
INTEGER NEWSIZE, FLAG
!*
NEWSIZE = F_C3-F_C0+X'10000'; ! ADD 64K
CHANGEFILESIZE(OUTPUT,NEWSIZE,FLAG)
IF FLAG # 0 THEN START
SSMESS(FLAG)
REPORT("FAILED TO EXPAND P. OUTPUT")
STOPBASE
FINISH
F_C3 = F_C0+NEWSIZE
END
!*
!*
!*************************************************
!*
!* FAST FILE OP
!*
!*************************************************
!*
SYSTEMINTEGERFN FASTFILEOP(INTEGER ADA)
RESULT = 1
END
! SHOULD ONLY BA CALLED FOR DA - NOT IMPLEMENTED
!*
!*
!!
!!**********************************************************
!!
!! CLOSE FILE
!!
!!*******************************************************
!!
SYSTEMINTEGERFN CLOSE FILE(INTEGER AFD, ACCESS CUR AD)
RECORDNAME FD(NRFDFMT)
INTEGER FLAG
IF COMREG(25)&1 = 1 START
PRINTSTRING("
*** CLOSE FILE ENTERED ***
")
PHEX(AFD)
FINISH
RESULT = 0 IF AFD = 0; ! CANT DISC. IF NO PTR TO FD
FD == RECORD(AFD)
RESULT = 0 IF FD_ACCESS ROUTE = 3
IF COMREG(25) = 1 THEN RESULT = 0;! KEEP IF DIAGNOSE
DISCONNECT(FD_IDEN,FLAG)
IF FD_DSNUM = 99 THEN START
IF ENDLESS = 1 THEN DESTROY(OUTPUT,FLAG) C
ELSE SENDFILE(OUTPUT,".".OUTPUTQ,0,0,FLAG)
FINISH
RESULT = FLAG
END ; !CLOSE FILE
!*
!*
!!
!!**********************************************************
!!
!! OPEN FILE
!!
!!***********************************************************
!!
SYSTEMINTEGERFN OPEN FILE( C
INTEGER AFD, AT, ABUFF, LBUFF, ARS, ARC)
RECORDNAME FD(NRFDFMT)
RECORD R(RF)
OWNBYTEINTEGERARRAY TRANS(0 : 13) = C
C
1,1,1,0,2,2,2,0,1,1,3,3,1,3
STRING (32) USER, FILE
INTEGER CONAD, PROTECT, I
!*
FD == RECORD(AFD)
UNLESS FD_IDEN -> USER.(".").FILE THEN AT = 3 ELSE START
IF COMREG(25)&1 = 1 START
PRINTSTRING("
*** OPEN FILE - ")
PRINTSTRING(FD_IDEN)
WRITE(AT,1)
WRITE(FD_DSNUM,1)
FINISH
AT = TRANS(AT)
FINISH
PROTECT = 0
! PRIMARY INPUT -> EMAS PRIMARY INPUT
IF FD_ACCESS ROUTE = 1 START
FD_ACCESS ROUTE = 9
AT = 1
INPUTFSYS=((BYTEINTEGER(ADDR C
(INPUTF)+1)-'0')*10)+ C
(BYTEINTEGER(ADDR(INPUTF)+2)-'0')
PROTECT = (INPUTFSYS<<8)!X'80'
FINISH
! STANDARD FILE -> EMAS MAPPED FILE
IF FD_ACCESS ROUTE = 4 THEN FD_ACCESS ROUTE = 8
IF FD_DSNUM = 99 START
OUTFILE(FD_IDEN,X'10000',EIGHTSEGMENTS,0,CONAD,FLAG)
RESULT = FLAG UNLESS FLAG = 0
FINISH
CONNECT(FD_IDEN,AT,0,PROTECT,R,FLAG)
IF FLAG # 0 START
IF FD_DSNUM = 100 START
OUTFILE(FD_IDEN,X'10000',0,0,R_CONAD,FLAG)
PERMIT(FD_IDEN,"",1,PFLAG)
IF FLAG = 0 THEN -> OUT
FD_ACCESS ROUTE = 9
FINISH
REPORT("CONNECT FAILS")
RESULT = FLAG
FINISH
OUT:
FD_C0 = R_CONAD
FD_C1 = R_CONAD+INTEGER(R_CONAD+4); ! START
FD_C2 = FD_C1; ! CURPOINTER
IF FD_DSNUM = 100 THEN FD_C2 = FD_C0+INTEGER(R_CONAD)
FD_C3 = R_CONAD+INTEGER(R_CONAD+8)-1
! PHYSICAL END
! USE F_C3 CHECKING FOR EOF ON WRITES,
! USE F_C0+FIRST WORD OF FILE FOR DATA END ON READS.
FD_MAXREC = FD_C3-FD_C1
IF FD_DSNUM = 99 THEN FD_MAXREC = 133
RESULT = 0
END ; !OPEN FILE
!*
!!
!!****************************************************************
!!
!! POSITION SQ FILE
!!
!!****************************************************************
!!
SYSTEMINTEGERFN POSITION SQ FILE( C
INTEGER AD REC CCY, POSITION)
!!
!! THIS ROUTINE MAY ONLY BE USED ON FILES WHICH HAVE BEEN OPENED ACCESS
!! TYPE =10 OR 11.
!! POSITION - INDICATES THE TYPE OF POSITIONING REQUIRED AND HAS VALUES
!! = -1 BACKSPACE A RECORD
!! = 0 REWIND TO START OF FILE
!! = 1 SKIP TO END OF FILE (AFTER THE LAST RECORD)
!! = 2 SKIP ONE RECORD
!!
SWITCH ACT(-1 : 2)
INTEGER I, J, SPACE LEFT, L, END
RECORDNAME FD(NRFDFMT)
INTEGER TYPE
!*
RESULT = 1 UNLESS -1 <= POSITION <= 2
FD == RECORD(AD REC CCY-48)
TYPE = INTEGER(FD_C0+12)
TYPE=3 IF FD_ACCESS ROUTE=3
TYPE = FD_RECTYPE UNLESS TYPE = 3
-> ACT(POSITION)
!!
ACT(-1): ; ! BACKSPACE
IF TYPE = 3 START ; ! CHARACTER FILE
FD_C2 = FD_C2-1
CYCLE
FD_C2=FD_C1 AND EXIT IF FD_C2 <= FD_C1
FD_C2 = FD_C2-1
EXIT IF BYTEINTEGER(FD_C2) = NL
REPEAT
FD_C2=FD_C2+1 UNLESS FD_C2=FD_C1
FD_RECORDS=0
FINISH ELSE START
IF FD_RECTYPE = VARIABLE START
IF 0 <= FD_LASTREC <= 1 THEN -> END
! NO ACTION AT FRONT ALREADY
IF FD_LASTREC > 1 START ; ! HAVE BACK POINTER
FD_C2 = FD_LASTREC
FD_LASTREC = -1
FD_RECORDS = FD_RECORDS-1
FINISH
-> END
! NO POINTER - MUST LABORIOUSLY GO BACK TO THE BEGINNING AND COUNT
! FORWARDS TO CURRENT POSITION.
I = FD_C1+2
UNTIL I >= FD_C2 THEN CYCLE
J = I
L = (BYTEINTEGER(I-2)<<8)!BYTEINTEGER(I-1)
RESULT = 161 IF L = 0; ! INVALID RECORD LENGTH
I = I+L
REPEAT
FD_C2 = J-2
FINISH ELSE START
-> END IF FD_C1 <= FD_C2; ! AT FRONT ALREADY
FD_C2 = FD_C2-FD_RECSIZE
FINISH
FD_RECORDS = FD_RECORDS-1
IF FD_C2 = FD_C1 THEN FD_LASTREC = 0 ELSE FD_LASTREC = -1
FINISH
-> END
!!
ACT(0):
! REWIND
FD_C2 = FD_C1
FD_LASTREC = 0
FD_RECORDS = 0
-> END
!!
ACT(1):
! ENDFILE
IF TYPE = 3 START
FD_RECORDS = 0
IF FD_ACCESS ROUTE=3 THEN FD_C2=FD_C3 ELSEC
FD_C2=FD_C0+INTEGER(FD_C0)
FINISH ELSE START
I = FD_C1
FD_RECORDS = 0
IF FD_RECTYPE = VARIABLE START
END = FD_C0+INTEGER(FD_C0)
UNTIL I >= END THEN CYCLE
L = (BYTEINTEGER(I)<<8)!BYTEINTEGER(I+1)
I = I+L
FD_RECORDS = FD_RECORDS+1
REPEAT
FD_LASTREC = I-L
FINISH
FD_C2 = I
FINISH
-> END
!!
ACT(2):
! SKIP
IF TYPE = 3 START
RESULT = 153 IF FD_C2 > FD_C1
CYCLE I = FD_C2,1,FD_C0+INTEGER(FD_C0)
RESULT = 153 IF FD_C2 > FD_C0+INTEGER(FD_C0)
EXIT IF BYTEINTEGER(I) = NL
REPEAT
FD_C2 = I+1
FD_RECORDS =0
FINISH ELSE START
IF FD_RECTYPE = VARIABLE START
I = 0
MOVE(2,FD_C2,ADDR(I)+2)
IF FD_C2+1+I > FD_C0+INTEGER(FD_C0) THEN RESULT = 153
! EOF
FD_RECSIZE = I
FD_LASTREC = FD_C2
FINISH ELSE START
RESULT = 153 IF FD_C2+FD_RECSIZE > FD_C0+INTEGER(FD_ C
C0)
FD_C2 = FD_C2+FD_RECSIZE
FINISH
FD_C2 = FD_C2+FD_RECSIZE
FD_RECORDS = FD_RECORDS+1
FINISH
-> END
!!
END:
! RESET MAXREC WHICH MAY HAVE BEEN REDUCED IF NEAR EOF
IF TYPE = 3 THEN FD_MAXREC = FD_C3-FD_C2 C
ELSE FD_MAXREC = FD_C3-FD_AREC
IF TYPE = 3 THEN FD_AREC = FD_C2 ELSE FD_AREC = FD_C2+2
RESULT =0 IF TYPE=3
IF FD_MAXREC > INTEGER(FD_C0+24)>>16 C
THEN FD_MAXREC = INTEGER(FD_C0+24)>>16
RESULT = 0
END ; !POSITION SQ FILE
!*
!*
!!
!*
!*
!!
!!***********************************************************
!!
!! CHANGE USE
!!
!!*********************************************************
!!
! %SYSTEMROUTINE CHANGE USE(%STRING (31) S, %C
! %INTEGER NEW USE, %INTEGERNAME FLAG)
! %IF NEW USE = 0 %THEN %START
!READ/WRITE
! NEW USE = 3
! %FINISH %ELSE NEW USE = 5
!READ/EXECUTE
! CHANGE ACCESS(S,NEW USE,FLAG)
! %END
!CHANGE USE
!*
!!***************************************************************
!!
!! SET CONTENT LIMIT
!!
!!*****************************************************************
!!
SYSTEMINTEGERFN SET CONTENT LIMIT(STRING (31) S, INTEGER NL)
INTEGER FLAG
!!
RESULT = 0 IF NL = 0
CHANGEFILESIZE(S,NL,FLAG)
RESULT = FLAG
END ; !SET CONTENT LIMIT
!**************************************************************************
!!
!! CALL SPOOLER VIA DIRECTOR
!!
!!
!!
ROUTINE CALL SPOOLER(INTEGER DEST, STRING (21) MESS, C
RECORDNAME REQ)
!!
RECORDSPEC REQ(REQF)
INTEGER FLAG
!!
REQ = 0
REQ_DEST = X'FFFF0000'!DEST
REQ_USER = SSOWNER
REQ_FILE = INPUTF
! WAIT IF NEED BE
IF MESS = "REQUEUE FILE " THEN REQ_FLAG = 1
!!
FLAG = DPON2(SPOOLER,REQ,1,7)
IF FLAG # 0 START
PRINTSTRING("
DPON2 ".MESS." FAILS, FLAG= ")
WRITE(FLAG,8)
NEWLINES(2)
STOP BASE
FINISH
!BCPUTIME=REQ_FLAG>>16
FLAG = REQ_FLAG>>24
IF FLAG # 0 START
PRINTSTRING("
DPON2 ".MESS." FAILS, FLAG = ")
WRITE(FLAG,1)
IF FLAG = 206 THEN PRINTSTRING("
USER NOT KNOWN")
IF FLAG = 207 THEN PRINTSTRING(" NO FILES ")
IF FLAG = 208 THEN PRINTSTRING(" FILE NOT VALID ")
NEWLINES(2)
STOP BASE
FINISH
END ; ! OF CALL SPOOLER
!!
!*
!!
!!*********************************************************
!!
!! JBR CONTROL ***** ENTRY POINT *****
!!
!!*********************************************************
!!
!*
!* TRANSFER CONTROL HERE AFTER SUBSYSTEM ENTRY
!*
SYSTEMROUTINE JBRCONTROL
RECORD R(RF)
RECORD P(PF)
RECORDNAME REP2(REP2F)
RECORDNAME REP(REPF)
STRING (31) S
STRING (6) FILE
INTEGER I, A, B, C, D, E, F, G, FLAG
!!
!*
! STORE LNB TO RECOVER FROM HASTY EXITS
!*
*STLN_KEEPLNB
!!
COMREG(36) = KEEPLNB&X'FFFC0000'; ! BASE OF STACK SEGMENT
INTEGER(COMREG(36)) = 0; ! STOP DIAGNOSTICS AT BOTTOM
!!
INPUT = "IDLE"
SENSITIVE = 1
!!
!! SET UP CONT. TRAP TO ENABLE ASYNCHRONOUS INTERRUPTS.
!! NOTE THIS SHOULD REALLY BE DONE LATER IN INITFILE,
!! BUT ON EMAS IT HAS TO BE EARLIER TO ALLOW S/ABORT
!!
I = PRIME CONTINGENCY(ONTRAPE)
DRESUME(-2,0,0)
!!
CONNECT("JDEFAULTS",0,0,0,R,I)
IF I # 0 THEN JDEFADDR = 0 C
AND BATCH OPTIONS = X'81000001' C
ELSE JDEFADDR = R_CONAD C
AND BATCHOPTIONS = INTEGER(R_CONAD+60)
!!
CYCLE
SELECT OUTPUT(100)
SJVERSION = RELEASE
! PRINTSTRING("***JOBBER JOURNAL*** (VERSION -".SJVERSION. %C
") FOR EXECUTION OF ")
CALL SPOOLER(60,"REQUEST INPUT FILE",P)
REP2 == P
REP == P
IF 1 <= LENGTH(REP2_FILE) <= 6 C
AND 1 <= LENGTH(REP2_OUTPUTQ) <= 15 C
THEN FILE = REP2_FILE C
ELSE FILE = REP_FILE
OUTPUT = "JO#1"
INPUTF = FILE
INPUT = SPOOLER.".".FILE
!PRINTSTRING(INPUT." AT ".DATE." ".TIME)
! NEWLINES(2)
SENSITIVE = 0
EMASJBR
SENSITIVE = 1
!!
!! KEEPLNB2 RETURNS HERE
!!
SELECT OUTPUT(100)
SDISCONNECT(INPUT,INPUTFSYS,FLAG)
IF FLAG # 0 THEN START
PRINTSTRING("
SDISCONNECT ".INPUT." FAILS, FLAG = ")
WRITE(FLAG,1)
STOP BASE
FINISH
CALL SPOOLER(61,"DELETE FILE ",P)
INPUT = "IDLE"
REPEAT
!!
END ; ! OF CONTROL
!!
!!*********************************************************
!!
!! STOP BASE
!!
!!**********************************************************
!!
SYSTEMROUTINE STOP BASE
INTEGER I
RECORDNAME F(NRFDFMT)
SYSTEMINTEGERMAPSPEC FDMAP(INTEGER N)
!!
IF SENSITIVE = 1 THEN START
! STRAIGHT BACK TO SUBSYSTEM TO STOP PROCESS.
*LLN_KEEPLNB
*EXIT_-64
FINISH
I = FDMAP(99)
IF I # 0 START
F == RECORD(I)
CHANGEFILESIZE(F_IDEN,INTEGER(F_C0),FLAG)
IF ENDLESS = 1 THEN DISCONNECT(F_IDEN,I) C
AND DESTROY(F_IDEN,I) C
ELSE SENDFILE(F_IDEN,".".OUTPUTQ,0,0,FLAG)
! PUT BACK LNB AND EXIT BACK TO JBRCONTROL
FINISH
*LLN_KEEP2LNB
*EXIT_-64
END ; ! OF STOP BASE
!!
!! ODDS AND ENDS
!!
SYSTEMROUTINE GENOMF
END
SYSTEMROUTINE DATIME(STRINGNAME D, T)
D = DATE
T = TIME
END
SYSTEMROUTINE LD
END
SYSTEMROUTINE READERRORDATA(STRINGNAME S, INTEGERNAME I)
END
!!
!!***********************************************************
!!
!! SUPER STOP
!!
!!************************************************************
!!
SYSTEMROUTINE SUPERSTOP
RECORD P(PF)
!!
!! COME HERE ON RECEIPT OF AN INTERRUPT CLASS=65.
!! AS GENERATED BY AN INT : A
!! OUTPUT FILE IS NOT PRINTED , BUT LEFT AROUND.
!!
CALL SPOOLER(61,"REQUEUE FILE ",P) UNLESS INPUT = "IDLE"
*LLN_KEEPLNB
*EXIT_-64
END ; ! OF SUPERSTOP
!*********************************************
!* *
!* THIS ROUTINE RECODES FROM HEX INTO NEW *
!* RANGE ASSEMBLY CODE. *
!* *
!*********************************************
EXTERNALROUTINE NCODE(INTEGER START, FINISH, CA)
SYSTEMROUTINESPEC NCODE(INTEGER START, FINISH, CA)
NCODE(START,FINISH,CA)
END
ENDOFFILE