SYSTEMROUTINESPEC OPER(INTEGER OPER NO, STRING (255) S)
EXTERNALINTEGERFNSPEC DDISCONNECT(STRING (6) USER, STRING (11) FILE, INTEGER FSYS, DESTROY)
EXTERNALINTEGERFNSPEC DCHSIZE(STRING (6) USER, STRING (11) FILE, INTEGER FSYS, NEWSIZE)
EXTERNALSTRINGFNSPEC DERRS(INTEGER FLAG)
EXTERNALINTEGERFNSPEC DCONNECT(STRING (6) USER, STRING (11) FILE, INTEGER FSYS, MODE, APF, C
INTEGERNAME SEG, GAP)
EXTERNALINTEGERFNSPEC DEXECMESS(STRING (6) USER, INTEGER SACT, LEN, ADR)
EXTERNALINTEGERFNSPEC DCREATE(STRING (6) USER, STRING (11) FILE, INTEGER FSYS, NKB, TYPE)
EXTERNALINTEGERFNSPEC DFILENAMES(STRING (6) USER, RECORDARRAYNAME INF, C
INTEGERNAME FILENUM, MAXREC, NFILES, INTEGER FSYS, TYPE)
EXTERNALINTEGERFNSPEC DPON2(STRING (6) USER, RECORDNAME P, INTEGER MSG NO, OUT NO)
EXTERNALROUTINESPEC DSTOP(INTEGER REASON)
EXTERNALINTEGERFNSPEC DRENAME(STRING (6) USER, STRING (11) OLDNAME, NEWNAME, INTEGER FSYS)
EXTERNALINTEGERFNSPEC DDESTROY(STRING (6) USER, STRING (11) FILE, STRING (8) DATE, C
INTEGER FSYS, TYPE)
!!
!!
EXTRINSICSTRING (6) MY NAME
EXTRINSICINTEGER MY SERVICE NUMBER
EXTRINSICINTEGER MY FSYS
EXTRINSICINTEGER OPER NO
!!
!!
CONSTSTRING (7) JOURNAL = "JOURNAL"; !SPOOLR QUEUE
CONSTSTRINGNAME DATE=X'80C0003F'
CONSTSTRINGNAME TIME=X'80C0004B'
CONSTSTRING (1) SNL = "
"
CONSTINTEGER ATRANS = X'80C0008F'; !ADDR OF MASTER I TO E AND E TO I TABLES
CONSTINTEGER NOT ASSIGNED = X'80808080'; !INTERNAL UNASSIGNED PATTERN
CONSTLONGINTEGER SECS70=X'0000000083AA7E80';! SECS DITTOM
CONSTINTEGER R = B'00000001'; !READ ACCESS
CONSTINTEGER W = B'00000010'; !WRITE ACCESS
CONSTINTEGER SHARED = B'00001000'
CONSTINTEGER SECTION SIZE = 64; !SECTION SIZE IN KBYTES
CONSTINTEGER FILE HEADER SIZE = 32; !STANDARD FILE HEADER SIZE
CONSTINTEGER MAX OPER = 7; !MAXIMUM OPER NUMBER
CONSTINTEGER MAX STREAMS = 7; !MAX NUMBER OF OUTPUT STREAMS
CONSTINTEGER PROMPT REPLY DACT = 19; !ACTIVITY SHOULD REQUIRES REPLIES FROM PROMPT ON
CONSTINTEGER SPOOLR REPLY = 23
CONSTINTEGER MAX REPLY INDEX = 127
CONSTINTEGER SPOOL LOG REPLY=(MAX REPLY INDEX+1)<<8!SPOOLR REPLY
CONSTINTEGER OPER PROMPT = X'320008'; !SERVICE NUMBER OF OPER PROMPT
CONSTBYTEINTEGERARRAY HEX(0 : 15) = C
'0','1','2','3','4','5','6','7',
'8','9','A','B','C','D','E','F'
!!
!!
ROUTINESPEC IOCP(INTEGER EP, N)
!!
!!
RECORDFORMAT PE(INTEGER DEST, SRCE, P1, P2, P3, P4, P5, P6)
RECORDFORMAT FHF(INTEGER END, START, SIZE, TYPE, SPARE, DATETIME, S1, S2)
!!
!!
OWNINTEGER CURRENT STREAM = 0; !DEFAULT AND CURRENT OUTPUT STREAM
OWNSTRING (132) ARRAY OPER BUFFER(0 : MAX OPER) = C
""(MAX OPER + 1)
!OPER OUTPUT SAVED HERE UNTIL A NEWLINE OR FULL
OWNINTEGERARRAY CONADS(1 : MAX STREAMS) = C
0(MAX STREAMS)
!CONNECT ADDRESS OF OUTPUT STREAMS
!!
!!
EXTERNALINTEGERFN VALIDATE(INTEGER ADR, LEN, RW)
!!
!!
!! FUNCTION VALIDATES THE AREA SPECIFIED FOR READ OR WRITE ACCESS
!! RESULT = 1 AREA OK (ACCESSIBLE)
!! RESULT = 0 AREA NOT OK (INACCESSIBLE)
!! RW SHOULD BE SET 0 (READ ACCESS)
!! OR 1 (WRITE ACCESS)
!!
!!
INTEGER INSEG1, INSEG2
LONGINTEGER DR
CONSTINTEGER WRITE = 1
RESULT = 0 UNLESS 0 < LEN <= X'40000'; ! DON'T ALLOW > 1 SEG ANYWAY
! WE WANT TO COVER THE SEG BOUNDARY CASE HERE
IF ADR>>18 # (ADR+LEN-1)>>18 START
INSEG2 = (ADR+LEN)&X'3FFFF'; !HIGHER SEGMENT NUMBER
INSEG1 = LEN-INSEG2; !LOWER SEGMENT NUMBER
RESULT = VALIDATE(ADR,INSEG1,RW)&VALIDATE(ADR+INSEG1,INSEG2,RW)
!OK ONLY IF BOTH VALIDATE
FINISH
DR = X'1800000000000000'!(LENGTHENI(LEN)<<32)!ADR
!SET UP A DESCIPTOR FOR AREA
*LD_DR
*VAL_(LNB +1)
*JCC_8,<CCZER>
*JCC_4,<CCONE>
*JCC_2,<CCTWO>
! THEN CC=3, INVALID
RESULT = 0
CCZER: ! READ AND WRITE PERMITTED
RESULT = 1; ! OK
CCONE: ! READ, BUT NOT WRITE, PERMITTED
IF RW = WRITE THEN RESULT = 0; ! BAD
RESULT = 1; ! OK
CCTWO: ! WRITE, BUT NOT READ, PERMITTED
RESULT = 0; ! BAD
END ; !OF INTEGERFN VALIDATE
!!
!!
INTEGERFN CURRENT PACKED DT
!!
!* GIVES CURRENT DT IN NEW PACKED FORM
!!
CONSTLONGINTEGER MILL=1000000
*RRTC_0; *USH_-1
*SHS_1; *USH_1
*IMDV_MILL
*ISB_SECS70; *STUH_B
*OR_X'80000000'
*EXIT_-64
END
!!
!!
SYSTEMROUTINE STOP
DSTOP(100)
END ; !OF ROUTINE STOP
!!
!!
EXTERNALROUTINE I TO E(INTEGER AD, L)
INTEGER J
J = INTEGER(ATRANS); !ADDR OF I TO E TABLE IN PUBLIC SEGMENT
*LB_L
*LDTB_X'18000000'
*LDB_B
*LDA_AD
*LSS_J
*LUH_X'18000100'
*TTR_L =DR
END ; !OF I TO E
!!
!!
EXTERNALROUTINE E TO I(INTEGER AD, L)
INTEGER J
J = INTEGER(ATRANS)+256; !ADDR OF E TO I TABLE IN PUBLIC SEGMENT
*LB_L
*LDTB_X'18000000'
*LDB_B
*LDA_AD
*LSS_J
*LUH_X'18000100'
*TTR_L =DR
END ; !OF E TO I
!!
!!
SYSTEMROUTINE MOVE(INTEGER LENGTH, FROM, TO)
!!
!!
!! MOVES "LENGTH" BYTES "FROM" "TO"
!!
!!
*LDTB_X'18000000'
*LDB_LENGTH ; *LDA_FROM
*CYD_0 ; *LDA_TO
*MV_L =DR
END ; !OF ROUTINE MOVE
!!
!!
SYSTEMROUTINE FILL(INTEGER LENGTH, FROM, FILLER)
!!
!!
!! FILL "LENGTH" BYTES "FROM" WITH CHARACTER "FILLER"
!!
!!
*LB_LENGTH
*LDTB_X'18000000'
*LDB_B
*LDA_FROM
*LB_FILLER
*MVL_L =DR
END ; !OF ROUTINE FILL
!!
!!
EXTERNALSTRING (15) FN I TO S(INTEGER N)
!!
!!
!! TURNS AN INTEGER INTO A STRING USES MACHINE CODE
!!
!!
STRING (16) S
INTEGER D0, D1, D2, D3
*LSS_N; *CDEC_0
*LD_S; *INCA_1; ! PAST LENGTH BYTE
*CPB_B ; ! SET CC=0
*SUPK_L =15,0,32; ! UNPACK 15 DIGITS SPACE FILL
*STD_D2; ! FINAL DR FOR LENGTH CALCS
*JCC_8,<WASZERO>; ! N=0 CASE
*LSD_TOS ; *ST_D0; ! SIGN DESCRIPTOR STKED BY SUPK
*LD_S; *INCA_1
*MVL_L =15,15,48; ! FORCE IN ISO ZONE CODES
IF N < 0 THEN BYTEINTEGER(D1) = '-' AND D1 = D1-1
BYTEINTEGER(D1) = D3-D1-1
RESULT = STRING(D1)
WASZERO:
RESULT = "0"
END ; !OF STRINGFN I TO S
!!
!!
SYSTEMROUTINE WRITE(INTEGER VALUE, PLACES)
STRING (16) S
INTEGER D0, D1, D2, D3, L
PLACES = PLACES&15
*LSS_VALUE; *CDEC_0
*LD_S; *INCA_1; *STD_TOS
*CPB_B ; ! SET CC=0
*SUPK_L =15,0,32; ! UNPACK & SPACE FILL
*STD_D2; *JCC_8,<WASZERO>
*LD_TOS ; *STD_D0; ! FOR SIGN INSERTION
*LD_TOS
*MVL_L =15,63,0; ! FORCE ISO ZONE CODES
IF VALUE < 0 THEN BYTEINTEGER(D1) = '-'
L = D3-D1
OUT:
IF PLACES >= L THEN L = PLACES+1
D3 = D3-L-1
BYTEINTEGER(D3) = L
IOCP(15,D3)
RETURN
WASZERO:
BYTEINTEGER(D3-1) = '0'
L = 2; -> OUT
END ; !OF ROUTINE WRITE
!!
!!
EXTERNALSTRING (8) FN H TO S(INTEGER VALUE, PLACES)
!!
!!
!! TURNS AN INTEGER INTO A HEXIDECIMAL STRING OF GIVEN LENGTH
!! USES MACHINE CODE
!!
!!
STRING (8) S
INTEGER I
I = 64-4*PLACES
*LD_S; *LSS_PLACES; *ST_(DR )
*INCA_1; *STD_TOS ; *STD_TOS
*LSS_VALUE; *LUH_0; *USH_I
*MPSR_X'24'; ! SET CC=1
*SUPK_L =8
*LD_TOS ; *ANDS_L =8,0,15; ! THROW AWAY ZONE CODES
*LSS_HEX+4; *LUH_X'18000010'
*LD_TOS ; *TTR_L =8
RESULT = S
END ; !OF STRINGFN H TO S
!!
!!
EXTERNALINTEGERFN S TO I(STRINGNAME S)
!!
!!
!! TURNS A STRING INTO AN INTEGER
!!
!!
STRING (255) P
INTEGER TOTAL, SIGN, AD, I, J, HEX
HEX = 0; TOTAL = 0; SIGN = 1
AD = ADDR(P)
A: IF S -> (" ").S THEN -> A; !CHOP LEADING SPACES
IF S -> ("-").S THEN SIGN = -1
IF S -> ("X").S THEN HEX = 1 AND -> A
P = S
UNLESS S -> P.(" ").S THEN S = ""
I = 1
WHILE I <= BYTEINTEGER(AD) CYCLE
J = BYTE INTEGER(I+AD)
-> FAULT UNLESS '0' <= J <= '9' OR (HEX # 0 AND 'A' <= J <= 'F')
IF HEX = 0 THEN TOTAL = 10*TOTAL ELSE TOTAL = TOTAL<<4+9*J>>6
TOTAL = TOTAL+J&15; I = I+1
REPEAT
IF HEX # 0 AND I > 9 THEN -> FAULT
IF I > 1 THEN RESULT = SIGN*TOTAL
FAULT:
S = P.S
RESULT = NOT ASSIGNED
END ; !OF INTEGERFN S TO I
!!
!!
EXTERNALROUTINE DUMP(INTEGER START, FINISH, CONAD)
!!
!!
!! DUMPS AREA SPECIFIED BY START AND FINISH IN HEXIDECIMAL
!! ACCEPTS PARAMETERS AS START, FINISH OR AS START,LENGTH WITH CONAD
!! SPECIFYING THE ACTUAL ADDRESS OF THE AREA BEING DUMPED
!!
!!
CONSTBYTEINTEGERARRAY TABLE(0 : 255) = C
'_'(32),
' ','!','"','#','$','%','&','''','(',
')','*','+',',','-','.','/','0','1',
'2','3','4','5','6','7','8','9',':',
';','<','=','>','?','@','A','B','C',
'D','E','F','G','H','I','J','K','L',
'M','N','O','P','Q','R','S','T','U',
'V','W','X','Y','Z','[','¬',']','^',
'_','`','a','b','c','d','e','f','g',
'h','i','j','k','l','m','n','o','p',
'q','r','s','t','u','v','w','x','y',
'z','{','|','}','~','_'(129)
STRING (255) S
INTEGER I, J, ABOVE, ACTUAL START
!TEST IS TO SEE IF LENGTH< START
FINISH = START+FINISH-1 IF FINISH < START
!MUST MEAN START, LENGTH
START = START&X'FFFFFFFC'
ACTUAL START = START
CONAD = CONAD&X'FFFFFFFC'
FINISH = ((FINISH+4)&X'FFFFFFFC')-1
RETURN IF FINISH < START
ABOVE = 0
-> PRINTLINE; !MUST PRINT FIRST LINE IN FULL
NEXTLINE:
-> PRINTLINE IF FINISH-START < 32
!MUST PRINT LAST LINE
*LDA_START; !CHECK IF SAME AS PREVIOUS LINE
*LDTB_X'18000020'
*CYD_0
*INCA_-32
*CPS_ L = DR
*JCC_7, < PRINTLINE >
ABOVE = ABOVE+1
START = START+32
-> NEXTLINE
PRINTLINE:
IF ABOVE # 0 START
SPACES(50)
IF ABOVE = 1 THEN PRINT STRING(" LINE ") ELSE PRINT STRING(I TO S(ABOVE)." LINES ")
PRINT STRING("AS ABOVE".SNL)
ABOVE = 0
FINISH
S = "*"
! %CYCLE I = START,1,START+31
! J = BYTEINTEGER(I)
! %UNLESS 32 <= J < 127 %THEN J = '_'
! S = S.TO STRING(J)
! %REPEAT
I = ADDR(TABLE(0))
J = ADDR(S)+2
*LDTB_X'18000020'
*LDA_START
*CYD_0
*LDA_J
*MV_L =DR
*LB_32
*LDTB_X'18000000'
*LDB_B
*LDA_J
*LSS_I
*LUH_X'18000100'
*TTR_L =DR
LENGTH(S) = 33
S = S."* (".H TO S(CONAD+(START-ACTUAL START),8).") "
CYCLE I = START,4,START+28
S = S.H TO S(INTEGER(I),8)." "
REPEAT
START = START+32
PRINT STRING(S.SNL)
-> NEXTLINE UNLESS START > FINISH
END ; ! OF DUMP
!!
!!
EXTERNALROUTINE PT REC(RECORDNAME P)
!!
!!
!! PRINT RECORD P AS A STRING
!!
!!
RECORDSPEC P(PE)
STRING (255) S
INTEGER I, J, K, CHAR
S = ""
J = ADDR(P_DEST)
K = 1
CYCLE I = J,1,J+31
S = S.H TO S(BYTEINTEGER(I),2); !DONE THIS WAY TO AVOID UNASSIGNED CHECK
S = S." " AND K = 0 IF K = 4
K = K+1
REPEAT
S = S." "
J = ADDR(P_P1)
CYCLE I = J,1,J+23
CHAR = BYTEINTEGER(I)
CHAR = ' ' UNLESS 32 < CHAR < 127
S = S.TO STRING(CHAR)
REPEAT
PRINT STRING(S.SNL)
END ; !OF ROUTINE PT REC
!!
!!
EXTERNALROUTINE PROMPT(STRING (23) S)
!!
!!
!! PUT A PROMPT UP ON THE CURRENT OPER
!!
!!
RECORDFORMAT PF(INTEGER DEST, SRCE, STRING (23) TEXT)
RECORD P(PF)
INTEGER FLAG
P_DEST = OPER PROMPT!(OPER NO)<<8
P_SRCE = MY SERVICE NUMBER!PROMPT REPLY DACT
P_TEXT = S
FLAG = DPON2("",P,0,6)
END ; !OF ROUTINE PROMPT
!!
!!
ROUTINE SEND TO SPOOLR(STRING (11) FILE, INTEGER CADDR, STREAM, STRING (15) QUEUE)
!!
!! Send a file to SPOOLR. If queue is LP, also send a copy to JOURNAL.
!!
RECORD P(PE)
STRING (11) NEWNAME, JFILE
INTEGER FLAG, LEN, START, I, SEG, GAP, CCADDR
STRING (255) S, T
RECORDNAME FILE HEADER(FHF)
FILE HEADER == RECORD(CADDR)
START = FILE HEADER_START
LEN = FILE HEADER_END-START
IF QUEUE = "LP" START
JFILE = "J".FILE
FLAG = DCREATE(MYNAME,JFILE,MYFSYS,(LEN+START+1023)>>10,4)
IF FLAG = 0 START
SEG = 0; GAP = 0
FLAG = DCONNECT(MYNAME,JFILE,MYFSYS,R!W,0,SEG,GAP)
IF FLAG = 0 START
CCADDR = SEG<<18
MOVE(LEN+START,CADDR,CCADDR)
SEND TO SPOOLR(JFILE,CCADDR,2,JOURNAL)
FINISH ELSE PRINTSTRING("Connect ".MYNAME.".".JFILE." fails: ".DERRS(FLAG).SNL)
FINISH ELSE PRINTSTRING("Create ".MYNAME.".".JFILE." fails: ".DERRS(FLAG).SNL)
FINISH
IF QUEUE = "LPONLY" THEN QUEUE = "LP"
FLAG = DDISCONNECT(MYNAME,FILE,MYFSYS,0)
IF LEN > 0 START
IF STREAM = 0 THEN NEWNAME = FILE ELSE START
S = DATE
LENGTH(S) = 2;!DAY ONLY
T = TIME
S = "M".S."#".T
LENGTH(S) = 6;!+HOURS
BYTEINTEGER(ADDR(T)+3) = 2
I = STOI(STRING(ADDR(T)+3))
CYCLE I = I, 1, 99
IF I<10 THEN NEWNAME = S."0".ITOS(I) ELSE NEWNAME = S.ITOS(I)
IF QUEUE="LP" THEN NEWNAME=NEWNAME."L"
FLAG = DRENAME(MYNAME,FILE,NEWNAME,MYFSYS)
PRINT STRING("RENAME ".MYNAME.".".FILE." TO ".MYNAME.".".NEWNAME." FAILS ".DERRS(FLAG).SNL) C
IF FLAG # 0
EXIT IF FLAG = 0
REPEAT
FINISH
S = "DOCUMENT DEST=".QUEUE.",SRCE=".NEWNAME.",NAME=".NEWNAME.",USER=".MYNAME.",START=".ITOS(START). C
",LENGTH=".ITOS(LEN).",FSYS=".ITOS(MYFSYS)
LEN = LENGTH(S)
P = 0
FLAG = DEXECMESS("SPOOLR",SPOOL LOG REPLY,LENGTH(S),ADDR(S)+1)
IF FLAG # 0 THEN PRINTSTRING("Dspool ".MYNAME.".".NEWNAME." fails ".ITOS(FLAG).SNL)
FINISH ELSE FLAG = DDESTROY(MYNAME,FILE,"",MYFSYS,0)
END ; !OF SEND TO SPOOLR
!!
!!
ROUTINE ANY EXTRA LOGFILES(STRING (15) Q)
RECORDFORMAT DFF(STRING (11) NAME, INTEGER SP12, KBYTES, C
BYTEINTEGER ARCH, CODES, CCT, OWNP, EEP, USE, CODES2, SSBYTE, FLAGS, SP29, SP30, SP31)
RECORDARRAY DF(0 : 256)(DFF)
INTEGER FILENUM, MAXREC, NFILES, I, FLAG, SEG, GAP
STRING (11) F1, F2
MAXREC = 256
FILENUM = 0
NFILES = 0
FLAG = DFILENAMES(MYNAME,DF,FILENUM,MAXREC,NFILES,MYFSYS,0)
IF FLAG = 0 START
I = 0
WHILE I < MAXREC CYCLE
IF CHARNO(DF(I)_NAME,1) = 'M' START
IF DF(I)_NAME -> ("M").F1.("#").F2 START
PRINTSTRING("Extra logfile found".SNL)
SEG = 0; GAP = 0
FLAG = DCONNECT(MYNAME,DF(I)_NAME,MYFSYS,R,0,SEG,GAP)
IF SEG > 0 THEN SEND TO SPOOLR(DF(I)_NAME,SEG<<18,0,Q)
FINISH
FINISH
I = I+1
REPEAT
FINISH ELSE PRINTSTRING("Dfilenames ".MYNAME." ".ITOS(MYFSYS)." fails ".DERRS(FLAG).SNL)
END ; !OF ANY EXTRA LOGFILES
!!
!!
EXTERNALROUTINE SEND AND DEFINE(INTEGER STREAM, SIZE, STRING (15) Q)
!!
!! If the file "STREAMn" exists, send it to the specified queue.
!! Then create a new file "STREAMn" and associate it with the output stream.
!!
RECORDNAME FILE HEADER(FHF)
INTEGER SEG, GAP, FLAG, CADDR
STRING (11) FILE
STRING (255) FAILM
IF 1 <= STREAM <= MAX STREAMS START ; !VALID STREAM NO?
IF 1 <= LENGTH(Q) <= 15 START ; !VALID QUEUE NAME?
FILE = "STREAM".I TO S(STREAM)
CONADS(STREAM) = 0
ANY EXTRA LOGFILES(JOURNAL)
SEG = 0; GAP = 0
FLAG = DCONNECT(MYNAME,FILE,MYFSYS,R!W,0,SEG,GAP)
CADDR = SEG<<18
IF CADDR > 0 THEN SEND TO SPOOLR(FILE,CADDR,STREAM,Q)
UNLESS 1<= SIZE <= 1024 THEN RETURN
FLAG = DCREATE(MY NAME,FILE,MY FSYS,SIZE,4)
IF FLAG = 0 START
SEG = 0; GAP = 0; !ANY SEGMENT MINIMUM GAP
FLAG = DCONNECT(MY NAME,FILE,MY FSYS,R!W!SHARED,0,SEG,GAP)
IF FLAG = 0 START
CONADS(STREAM) = SEG<<18
FILE HEADER == RECORD(CONADS(STREAM))
FILE HEADER_START = FILE HEADER SIZE
FILE HEADER_END = FILE HEADER SIZE
FILE HEADER_SIZE = SIZE<<10
FILE HEADER_TYPE = 3
FILE HEADER_DATETIME = CURRENT PACKED DT
FILE HEADER_S1 = X'FFFFFF07'
RETURN
FINISH ELSE FAILM = "CONNECT ".MYNAME.".".FILE." FAILS ".DERRS(FLAG)
FINISH ELSE FAILM = "CREATE ".MYNAME.".".FILE." FAILS ".DERRS(FLAG)
FINISH ELSE FAILM = "INVALID OUTPUT QUEUE ".Q
FINISH ELSE FAILM = "INVALID STREAM NUMBER"
PRINT STRING("DEFINE STREAM ".I TO S(STREAM)." FAILS ".FAILM.SNL)
END ; !OF ROUTINE SEND AND DEFINE
!!
!!
ROUTINE UPDATE OUTPUT(INTEGER ADDRESS, LEN)
INTEGER END, SYM, SIZE, STREAM, SEG, GAP, FLAG
RECORDNAME FILE HEADER(FHF)
STRING (11) FILE
IF CURRENT STREAM = 0 START ; !OPER CONSOLE
END = ADDRESS+LEN
WHILE ADDRESS < END CYCLE
SYM = BYTEINTEGER(ADDRESS)
IF SYM = NL OR LENGTH(OPER BUFFER(OPER NO)) = 132 START
OPER(OPER NO,OPER BUFFER(OPER NO)); !OUTPUT THE BUFFER
IF CONADS(1) # 0 START ; !IS THERE A MAINLOG
SELECT OUTPUT(1); !MAIN LOG STREAM
PRINT STRING("DT: ".DATE." ".TIME." TO OPER".I TO S(OPER NO)." ".OPER BUFFER(OPER NO). C
SNL)
SELECT OUTPUT(0)
FINISH
OPER BUFFER(OPER NO) = ""
FINISH
OPER BUFFER(OPER NO) = OPER BUFFER(OPER NO).TO STRING(SYM) IF SYM # NL
ADDRESS = ADDRESS+1
REPEAT
FINISH ELSE START
FILE HEADER == RECORD(CONADS(CURRENT STREAM))
IF FILE HEADER_END+LEN > FILE HEADER_SIZE START
!END OF FILE
SIZE = FILE HEADER_SIZE>>10; !REMEMBER SIZE
STREAM = CURRENT STREAM
SELECT OUTPUT(0); !IN CASE ANY FAILURES DURING FILE SIZE CHANGE
FILE = "STREAM".I TO S(STREAM)
FLAG = DDISCONNECT(MY NAME,FILE,MY FSYS,0)
IF FLAG = 0 START
SIZE = SIZE+SECTION SIZE; !EXTEND IT BY A SECTION
IF SIZE > 256 THEN START
!DO NOT ALLOW LOG TO EXCEED 256K.
SEND AND DEFINE(STREAM,64,JOURNAL)
FILE HEADER == RECORD(CONADS(STREAM))
SELECT OUTPUT(STREAM)
FINISH ELSE START
FLAG = DCHSIZE(MY NAME,FILE,MY FSYS,SIZE)
IF FLAG = 0 START
SEG = 0; GAP = 0
FLAG = DCONNECT(MYNAME,FILE,MY FSYS,R!W!SHARED,0,SEG,GAP)
IF FLAG = 0 START
CONADS(STREAM) = SEG<<18
FILE HEADER == RECORD(CONADS(STREAM))
FILE HEADER_SIZE = SIZE<<10
SELECT OUTPUT(STREAM)
FINISH ELSE PRINT STRING("CONNECT ".MYNAME.".".FILE." FAILS ".DERRS(FLAG).SNL)
FINISH ELSE PRINT STRING("CHSIZE ".MYNAME.".".FILE." FAILS ".DERRS(FLAG).SNL)
FINISH
FINISH ELSE PRINT STRING("DISCONNECT ".MYNAME.".".FILE." FAILS ".DERRS(FLAG).SNL)
RETURN IF FLAG # 0
FINISH
MOVE(LEN,ADDRESS,FILE HEADER_END+CONADS(CURRENT STREAM))
FILE HEADER_END = FILE HEADER_END+LEN
FINISH
END ; !OF ROUTINE UPDATE OUTPUT
!!
!!
EXTERNALROUTINE LOG PRINT(STRING (255) S)
INTEGER I
IF CONADS(1) # 0 THEN CURRENT STREAM = 1
UPDATE OUTPUT(ADDR(S)+1, LENGTH(S))
CURRENT STREAM = 0
END ; !OF PRINTTOLOG
!!
!!
SYSTEMROUTINE IOCP(INTEGER EP, N)
INTEGER NUM, SYM
BYTEINTEGERARRAY S(0 : 255)
SWITCH IO(0 : 17)
-> IO(0) UNLESS 0 < EP <= 17
-> IO(EP)
IO(3): ! PRINTSYMBOL(N)
IO(5): ! PRINTCH(N)
UPDATE OUTPUT(ADDR(N)+3,1)
RETURN
IO(7): ! PRINTSTRING
IO(15): ! PRINTSTRING (ONLY VALID CHARS ALLOWED)
UPDATE OUTPUT(N+1,BYTEINTEGER(N))
RETURN
IO(17): ! MULSYMBOL
NUM = (N>>8)&255
SYM = N&255
FILL(NUM,ADDR(S(0)),SYM)
UPDATE OUTPUT(ADDR(S(0)),NUM)
RETURN
IO(9): !SELECT OUTPUT
IF 0 <= N <= MAX STREAMS START
IF N # 0 START ; !NOT OPER?
IF CONADS(N) = 0 START ; !NOT CONNECTED
PRINT STRING("SELECT OUTPUT ".I TO S(N)." FAILS STREAM NOT DEFINED".SNL)
RETURN
FINISH
FINISH
CURRENT STREAM = N
FINISH ELSE PRINT STRING("SELECT OUTPUT ".I TO S(N)." FAILS INVALID STREAM NUMBER".SNL)
RETURN
IO(16): !CLOSE STREAM
IO(0): !INVALID
IO(1): !READ SYMBOL
IO(2): !NEXT SYMBOL
IO(4): !READ CH
IO(6): !RECONSTRUCT
IO(8): !SELECT INPUT
IO(10): !ISO CARD
IO(11): !CHOP CURRENT OUTPUT
IO(12): !SET INPUT MARGIN
IO(13): !SET OUTPUT MARGIN
IO(14): !SET READ ADDRESS
PRINT STRING("ILLEGAL CALL ON IOCP EP = ")
WRITE(EP,2); NEWLINE
END ; !OF ROUTINE IOCP
!!
!!
ENDOFFILE