!*
!* CHOPER36 - 12th May 1982
!*
RECORDFORMAT PARMF(INTEGER DEST,SRCE,P1,P2,P3,P4,P5,P6)
EXTERNALROUTINESPEC PON(RECORD (PARMF)NAME P)
EXTERNALROUTINESPEC PTREC(RECORD (PARMF)NAME P)
EXTERNALROUTINESPEC PARSE COM(INTEGER SRCE,STRINGNAME S)
EXTERNALSTRINGFNSPEC STRINT(INTEGER I)
IF SSERIES=YES START
EXTERNALINTEGERFNSPEC REALISE(INTEGER AD)
FINISH
SYSTEMROUTINESPEC ITOE(INTEGER A,S)
SYSTEMROUTINESPEC ETOI(INTEGER A,S)
SYSTEMROUTINESPEC MOVE(INTEGER S,FROM,TO)
!*
RECORDFORMAT DEVICE ENTRY F(INTEGER BUFF S, C
X1,X2,X3,X4,X5,X6,X7, C
BUFF A,SCREEN DESC)
RECORDFORMAT MP F(INTEGER DEST,SRCE,STRING (23)TXT)
RECORDFORMAT PICTURE F(INTEGER LENGTH,UPDATED,DATA)
IF SSERIES=YES START
RECORDFORMAT TCBF(INTEGER COMMAND,STE,LEN,DATAD,NTCB,RESP, C
INTEGERARRAY PREAMBLE,POSTAMBLE(0:3))
FINISH ELSE START
RECORDFORMAT RCB F(INTEGER FLAGS,LSTBA,LBS,LBA, C
ALS,ALA,X1,X2)
FINISH
RECORDFORMAT SCREEN F(INTEGER PICTURE ID, C
STREAM CELL, C
LENGTH, C
HL CURSOR, C
PICTURE A,CURSOR,SIZE,CNTRL, C
BYTEINTEGER CODE, X, Y, WRITE PENDING)
IF SSERIES=YES START
RECORDFORMAT UNIT F(RECORD (TCBF) TCB1,TCB2,TCB3,TCB4, C
INTEGER BUFFER A,CALLER,READ Q, C
BYTEINTEGER INPUT ENABLED,INPUT MODE, C
COMMAND PENDING,ENTER PENDING,READ PENDING, C
BUFF STATE,SNO,STATE, C
STRING (31) PROMPT, C
STRING (40) INPUT LINE, C
RECORD (SCREEN F) SCREEN)
CONSTINTEGER UREC SPACE=576; ! compatible with full OPER
FINISH ELSE START
RECORDFORMAT UNIT F(RECORD (RCBF) RCB, C
INTEGER ALE0S,ALE0A,ALE1S,ALE1A,ALE2S,ALE2A, C
BUFFER A,CALLER,READ Q, C
BYTEINTEGER INPUT ENABLED,INPUT MODE, C
COMMAND PENDING,ENTER PENDING,READ PENDING, C
BUFF STATE, C
SNO,STATE, C
STRING (31)PROMPT, C
STRING (40)INPUT LINE, C
RECORD (SCREEN F) SCREEN)
CONSTINTEGER UREC SPACE=384
FINISH
OWNRECORD (DEVICE ENTRY F)NAME DEVICE ENTRY
OWNRECORD (MP F)NAME MP
OWNRECORD (PICTURE F)NAME OPERLOG
OWNRECORD (SCREEN F)NAME SCREEN
OWNRECORD (UNIT F)NAME U
!*
OWNRECORD (PARMF) Q
!*
OWNINTEGERARRAY CONTEXT(0:7)
OWNSTRING (40)EBCDICTXT,ISOTXT,MSG
!*
IF SSERIES=YES START
CONSTINTEGER INPUT=0
CONSTINTEGER OUTPUT=1
OWNINTEGER SINIT=0
FINISH ELSE START
OWNINTEGER INPUT
OWNINTEGER OUTPUT
FINISH
!*
CONSTINTEGER ATTENTION = 1
OWNINTEGER CLEAR3 = X'40151515'; ! EBCDIC SP AND 3 NLS
CONSTINTEGER COMMAND = X'2000'
CONSTINTEGER ENTER = X'8000'
CONSTINTEGER EXECUTE=X'30000C'
CONSTINTEGER EX REPLY=X'320003'
CONSTINTEGER HDR S = 8
CONSTINTEGER IDLE = 0
OWNINTEGER LAST3C = X'15030000'; ! LINE 21 FOR 3 LINES
OWNINTEGER LINE21C = X'15000000'; ! LINE 21 FOR 1 LINE
CONSTINTEGER NORMAL = 8
OWNINTEGER OP
CONSTINTEGER PGB = X'0100'
CONSTINTEGER PGF = X'1000'
CONSTINTEGER PROMPT ISSUED = 3
CONSTINTEGER READ ISSUED = 1
CONSTINTEGER WRITE ISSUED = 2
!*
CONSTINTEGER CONTROL WORD = C
X'00140000'
! SCR0 21L
IF SSERIES=YES START
OWNINTEGER INIT DATA=X'0000FF00'
FINISH ELSE START
CONSTINTEGERARRAY IN LBE(0:3) = C
X'04F00204', X'84E00100', X'84E00500', X'80E00302'
! READ(ALE2,40 BYTES TO INPUT LINE) INITIALISE WRITE CONTROL(ALE0) WRITE(ALE1)
CONSTINTEGERARRAY OUT LBE(0:3) = C
X'04010800', X'84E00100', X'84E00500', X'80E00302'
! CONNECT INITIALISE etc
FINISH
!*
CONSTBYTEINTEGERARRAY KYNL(0:1) = 1,10
OWNSTRING (8)COMMANDP = E"COMMAND:"
CONSTSTRINGNAME TIME = X'80C0004B'
!*
ROUTINE REPORT(STRING (63)TXT)
PRINTSTRING("**OPER ".TXT)
NEWLINE
END ; ! OF REPORT
!*
ROUTINE UPDATE OPERLOG(STRING (63)TXT)
INTEGER A
ISOTXT <- TXT
ISOTXT = ISOTXT." " WHILE LENGTH(ISOTXT) < 40
EBCDICTXT = ISOTXT
ITOE(ADDR(EBCDICTXT)+1,40)
A = ADDR(OPERLOG)
MOVE(OPERLOG_LENGTH - 41, C
A + HDR S + 41,A + HDR S)
MOVE(40,ADDR(EBCDICTXT)+1, C
A + HDR S + OPERLOG_LENGTH - 41)
PRINTSTRING(TIME." OPERLOG ".ISOTXT."
")
Q = 0
CYCLE A = 0, 1, 7
IF CONTEXT(A) # 0 AND C
OPERLOG_UPDATED&(1<<A)=0 THEN START
OPERLOG_UPDATED=OPERLOG_UPDATED!(1<<A)
Q_DEST = X'32000A' ! A<<8
PON(Q)
FINISH
REPEAT
END ; ! OF UPDATE OPERLOG
!*
EXTERNALROUTINE OPER(RECORD (PARMF)NAME P)
SWITCH ACT(1:19)
INTEGER BASE
INTEGER DACT
INTEGER DEST
INTEGER FLAG
INTEGER I
INTEGER L
INTEGER P1
INTEGER P2
INTEGER SCURSOR
INTEGER STATE
!*
ROUTINE FIRE(INTEGER CHAIN,CONTROL A,SIZE,BUFFER A)
IF SSERIES=YES START
U_TCB3_STE=REALISE(CONTROL A&X'FFFC0000')!1
U_TCB3_DATAD=CONTROL A
U_TCB4_STE=REALISE(BUFFER A&X'FFFC0000')!1
U_TCB4_LEN=SIZE
U_TCB4_DATAD=BUFFER A
FINISH ELSE START
U_RCB_LBA = CHAIN
U_ALE0A = CONTROL A
U_ALE1S = SIZE
U_ALE1A = BUFFER A
FINISH
Q = 0
Q_DEST = EXECUTE
Q_SRCE=EX REPLY!OP<<8
IF SSERIES=YES START
IF CHAIN=INPUT THEN Q_P1=ADDR(U_TCB1) ELSE Q_P1=ADDR(U_TCB2)
FINISH ELSE Q_P1=ADDR(U_RCB)
Q_P2 = U_SNO
IF SSERIES=NO THEN Q_P3 = X'11'; ! DO STREAM COMMAND + CLEAR ABNORMAL
PON(Q)
END ; ! OF FIRE
!*
ROUTINE DISPLAY SCREEN
OPERLOG_UPDATED = C
OPERLOG_UPDATED & (¬ (1<<OP))
MOVE(SCREEN_SIZE, C
SCREEN_PICTURE A + SCREEN_CURSOR + HDR S, C
U_BUFFER A)
FIRE(OUTPUT,ADDR(SCREEN_CNTRL),SCREEN_SIZE,U_BUFFER A)
U_STATE = WRITE ISSUED
END ; ! OF DISPLAY SCREEN
!*
! START OF MAIN PROGRAM
MP == P
DEST = P_DEST
OP = DEST >> 8 & 7
DACT = DEST & 255
P1 = P_P1
P2 = P_P2
! check/perform initialisation
BASE = CONTEXT(OP)
IF BASE = 0 START
IF DACT = 2 START
REPORT(STRINT(OP)." ALLOCATE P1=".STRINT(P1))
IF P1 = 0 START
DEVICE ENTRY == RECORD(P_P3)
BASE = DEVICE ENTRY_BUFF A
CONTEXT(OP) = BASE
U == RECORD(BASE)
IF (SSERIES=YES AND SINIT=0) OR C
(SSERIES=NO AND INPUT=0) START
! initialise own variables
IF SSERIES=YES THEN SINIT=1 ELSE START
INPUT = ADDR(IN LBE(0))
OUTPUT = ADDR(OUT LBE(1))
FINISH
OPERLOG==RECORD(INTEGER(INTEGER(X'80C0001C')+41<<2))
FINISH
U = 0
U_SNO = P_P2
IF SSERIES=YES START
U_TCB1_COMMAND=X'2F404002'; ! read
U_TCB1_STE=REALISE(ADDR(U_INPUT LINE)&X'FFFC0000')!1
U_TCB1_LEN=40
U_TCB1_DATAD=ADDR(U_INPUT LINE)+1
U_TCB1_NTCB=ADDR(U_TCB2)
U_TCB2_COMMAND=X'2E404081'; ! init
U_TCB2_STE=REALISE(ADDR(INIT DATA)&X'FFFC0000')!1
U_TCB2_LEN=4
U_TCB2_DATAD=ADDR(INIT DATA)
U_TCB2_NTCB=ADDR(U_TCB3)
U_TCB3_COMMAND=X'2E404085'; ! write control
U_TCB3_LEN=2
U_TCB3_NTCB=ADDR(U_TCB4)
U_TCB4_COMMAND=X'2E004083'; ! write
FINISH ELSE START
U_RCB_FLAGS = X'00FF4000'
U_RCB_LBS = 4*4
U_RCB_ALS = 3*2*4
U_RCB_ALA = ADDR(U_ALE0S)
U_ALE0S = 2; ! OTHER ALE FIELDS SET UP BY FIRE
U_ALE2S = 40
U_ALE2A = ADDR(U_INPUT LINE) + 1
FINISH
U_BUFFER A = BASE + UREC SPACE
SCREEN == U_SCREEN
SCREEN_LENGTH = OPERLOG_LENGTH
SCREEN_PICTURE A = ADDR(OPERLOG)
SCREEN_SIZE = 21 * 41
SCREEN_CNTRL = CONTROL WORD
SCREEN_CURSOR = OPERLOG_LENGTH - SCREEN_SIZE
IF SSERIES=YES THEN FIRE(OUTPUT,ADDR(LAST3C),4,ADDR(CLEAR3)) C
ELSE FIRE(ADDR(OUT LBE(0)),ADDR(LAST3C),4,ADDR(CLEAR3))
U_STATE = WRITE ISSUED
FINISH
FINISH ELSE START
REPORT(STRINT(OP)." NOT INITIALISED")
FINISH
RETURN
FINISH
!*
U == RECORD(BASE)
SCREEN == U_SCREEN
IF DACT=5 START ; ! analyse interrupt response
FLAG=P1>>20&15
IF FLAG&NORMAL#0 THEN DACT=15 ELSE START
IF FLAG=ATTENTION START
IF P1&ENTER#0 THEN DACT=16 ELSE C
IF P1&COMMAND#0 THEN DACT=17 ELSE C
IF P1&PGF#0 START
DACT=18
P1=1
P2=0
FINISH ELSE START
IF P1&PGB#0 START
DACT=18
P1=-1
P2=0
FINISH
FINISH
FINISH
FINISH
FINISH
IF DACT=5 START
REPORT(STRINT(OP)." abnormal termination")
->NOW IDLE
FINISH
->ACT(DACT)
!*
ACT(9):RETURN
ACT(*):
-> HELP
!*
ACT(3): ! execute failure
REPORT(STRINT(OP)." fire fails P1=".STRINT(P1))
-> NOW IDLE
ACT(7): ! WRITE LINE TO OPERLOG
ISOTXT = MP_TXT
IF ISOTXT -> ISOTXT.(STRING(ADDR(KYNL(0)))).MSG C
THEN I = I
ISOTXT = " 0/ ".ISOTXT
UPDATE OPERLOG(ISOTXT)
RETURN
ACT(15): ! normal termination
STATE = U_STATE
IF STATE = IDLE START
REPORT(STRINT(OP)." SPURIOUS TERMINATION")
-> HELP
FINISH
IF STATE = PROMPT ISSUED THEN U_INPUT ENABLED = 1
IF STATE = READ ISSUED START
U_INPUT ENABLED = 0
L = 40
CYCLE I = 1, 1, 40
IF BYTEINTEGER(ADDR(U_INPUT LINE)+I) = X'1D' START ; ! EBCDIC NL
L = I - 1
EXIT
FINISH
REPEAT
LENGTH(U_INPUT LINE) = L
ETOI(ADDR(U_INPUT LINE)+1, L)
PARSE COM(X'320007' ! OP << 8, U_INPUT LINE)
FINISH
-> NOW IDLE
!*
!*
ACT(16): ! ENTER KEY
IF U_INPUT ENABLED > 0 C
THEN U_ENTER PENDING = 1
-> LOOK FOR WORK
!*
ACT(17): ! COMMAND KEY
UNLESS U_STATE = PROMPT ISSUED START
IF U_INPUT ENABLED = 0 C
THEN U_COMMAND PENDING = 1
FINISH
-> LOOK FOR WORK
!*
ACT(18): ! PGF OR PGB
SCURSOR = SCREEN_CURSOR + P1 * SCREEN_SIZE
IF SCURSOR < 0 C
THEN SCURSOR = 0
IF SCURSOR+SCREEN_SIZE > SCREEN_LENGTH C
THEN SCURSOR = SCREEN_LENGTH - SCREEN_SIZE
OPERLOG_UPDATED = OPERLOG_UPDATED ! (1<<OP)
SCREEN_CURSOR = SCURSOR
-> LOOK FOR WORK
!*
HELP:
PRINTSTRING("** OPER RCVD:")
PTREC(P)
RETURN
!*
NOW IDLE:
U_STATE = IDLE
!*
ACT(10):
LOOK FOR WORK:
UNLESS U_STATE = IDLE THEN RETURN
IF U_ENTER PENDING > 0 START ; ! DEAL WITH 'ENTER'
U_ENTER PENDING = 0
FIRE(INPUT,ADDR(LAST3C),4,ADDR(CLEAR3))
U_STATE = READ ISSUED
RETURN
FINISH
IF U_COMMAND PENDING > 0 START ; ! DEAL WITH 'COMMAND'
U_COMMAND PENDING = 0
U_STATE = PROMPT ISSUED
FIRE(OUTPUT,ADDR(LINE21C),LENGTH(COMMANDP),ADDR(COMMANDP)+1)
RETURN
FINISH
IF OPERLOG_UPDATED & (1<<OP) > 0 C
THEN DISPLAY SCREEN
RETURN
!*
END ; ! OF OPER
ENDOFFILE