CONSTSTRING (16) VSN = "GROPE23 1/4/85"
RECORDFORMAT PARMF(INTEGER DEST,SRCE,P1,P2,P3,P4,P5,P6)
CONSTBYTEINTEGERARRAY HEXDS(0:15)='0','1','2','3','4','5','6','7',
'8','9','A','B','C','D','E','F'
EXTERNALINTEGERFNSPEC REALISE(INTEGER VAD)
EXTERNALSTRINGFNSPEC HTOS(INTEGER N,PL)
EXTERNALROUTINESPEC PRHEX(INTEGER N)
EXTERNALSTRINGFNSPEC STRINT(INTEGER N)
EXTERNALROUTINESPEC WAIT(INTEGER MILLISECS)
EXTERNALROUTINESPEC DUMPTABLE(INTEGER T,A,L)
EXTERNALINTEGERSPEC NDISCS
CONSTINTEGER REAL0ADDR=X'81000000'
!
! LP repertoire addresses and lengths for each of 16 cartidge settings
OWNINTEGERARRAY REPERTOIRE ADDR(0:15)
OWNINTEGERARRAY REPERTOIRE LEN(0:15)
!----------------------------------------------------------------------------------------------------
! %CONSTINTEGERARRAY LP96REP(0:23)=%C follows
ENDOFLIST
CONSTINTEGERARRAY LP96REP(0:23)=C
X'F0F1F2F3',X'F4F5F6F7',X'F8F94B60',X'7B6B614E',X'C1C2C3E9',
X'C4E4E2E3',X'C7C57DC8',X'D1D2D85C',X'D4D5D6D7',X'D9C9C6D3',
X'E5E6E7E8',X'7E4D505D',X'4C6D3F6E',X'5B7A7C4F',X'6C5E7F6F',
X'4AE05F5A',X'A8A979F0',X'81828384',X'85868788',X'89919293',
X'94959697',X'9899A2A3',X'A4A5A6A7',X'C06AA1D0'
!
LIST
! %CONSTINTEGERARRAY LP384REP(0:95)= %C follows
ENDOFLIST
CONSTINTEGERARRAY LP384REP(0:95)= C
X'F0F1F2F3',X'F4F5F6F7',X'F8F94B9C',X'7B6B614E',
X'C1C2C3E9',X'C4E4E2E3',X'C7C57DC8',X'D1D2D85C',
X'D4D5D6D7',X'D9C9C6D3',X'E5E6E7E8',X'7E4D505D',
X'6C5E7F6F',X'4AE05F5A',X'4C6D3F6E',X'5B7A7C4F',
X'81828384',X'85868788',X'89919293',X'F0F1F2F3',
X'F4F5F6F7',X'F8F94B60',X'94959697',X'9899A2A3',
X'A4A5A6A7',X'A8A979F0',X'9EADEFCA',X'7B6B614E',
X'C1C2C3E9',X'C4E4E2E3',X'C7C57DC8',X'D1D2D85C',
X'D4D5D6D7',X'D9C9C6D3',X'E5E6E7E8',X'7E4D505D',
X'6C5E7F6F',X'4AB7A05A',X'F0F1F2F3',X'F4F5F6F7',
X'F8F94B60',X'4CF08B6E',X'5B7A7C4F',X'C06A75D0',
X'9A6D749B',X'FCEAAFED',X'ACAB8F8E',X'8DB5B4B3',
X'787776DC',X'DDDEDFB8',X'B9BABBB0',X'7B6B614E',
X'C1C2C3E9',X'C4E4E2E3',X'C7C57DC8',X'D9C9C6D3',
X'D1D2D85C',X'F0F1F2F3',X'F4F5F6F7',X'F8F94B60',
X'D4D5D6D7',X'E5E6E7E8',X'7E4D505D',X'6C5E7F6F',
X'4AE05F5A',X'4CF08B6E',X'5B7A7C4F',X'A8A979F0',
X'81828384',X'85868788',X'89919293',X'94959697',
X'9899A2A3',X'A4A5A6A7',X'B1B2FAFB',X'C1C2C3E9',
X'F0F1F2F3',X'F4F5F6F7',X'F8F94B60',X'7B6B614E',
X'C4E4E2E3',X'C7C57DC8',X'D9C9C6D3',X'D1D2D85C',
X'D4D5D6D7',X'E5E6E7E8',X'7E4D505D',X'6C5EDBCB',
X'4AB7A05A',X'4CF08B6E',X'5B7A7C4F',X'EBBCA1BD',
X'8CAEBFBE',X'B6AAFDFE',X'9DEE80DA',X'C06D6AD0'
LIST
IF SSERIES=YES START
EXTERNALROUTINE DCU GROPE(RECORD (PARMF)NAME P)
EXTRINSICINTEGER FEP MAP
EXTERNALINTEGERFNSPEC PINT
EXTERNALROUTINESPEC OPMESS(STRING (63)S)
EXTERNALROUTINESPEC RETRY REPORTING(INTEGER PARM)
ROUTINESPEC FIRE IO(INTEGER PORT,LONGINTEGER ACT)
ROUTINESPEC FORM TABLES(INTEGER TABAD,TOP TAB ENT)
ROUTINESPEC FORMAT COMMS AREA(INTEGER TABAD,DCUNO,CAA)
ROUTINESPEC INVALIDATE(INTEGER ENT)
ROUTINESPEC NEW ENTRY(INTEGER DEVTYPE,SPSSM,PROPS0,PROPS1,AUTO)
ROUTINESPEC REMEMBER(INTEGER INF)
ROUTINESPEC DO(INTEGER COMMAND,DATAD,LEN)
ROUTINESPEC FORGETMENOT
ROUTINESPEC INIT RES PIC(INTEGER A,L)
SYSTEMROUTINESPEC MOVE(INTEGER L,F,T)
RECORDFORMAT ISTF(INTEGER LNB, PSR, PC, SSR, SF, IT, IC, SP)
RECORD (ISTF)NAME IST
RECORD (ISTF) SAVE IST
RECORDFORMAT DCUTF(BYTEINTEGER FLAGS,DEVTYPE,SPAREB,LINK, C
INTEGER PROPS0,PROPS1,DEV ENT BASE,UTAD,SPSSM,MNEMONIC, C
BYTEINTEGER MECHINDEX,PROPS03,SERVRT,STATE)
RECORDFORMAT UTEF(INTEGER PD,PP,BYTEINTEGER FMN,SP,STRM,FLAGS, C
INTEGER TCBA,A1,A2,A3,A4,IDEST,I1,I2,I3,S1,S2,L1,L2)
CONSTINTEGER SLOTSI=32; ! =LENGTH OF ABOVE FORMAT
RECORDFORMAT TCBF(INTEGER COMMAND,STE,LEN,DATA,NTCB,RESP, C
INTEGERARRAY PREAMBLE,POSTAMBLE(0:3))
CONSTINTEGERARRAY ADAPTOR BYTES(0:15)=C
0, 0, 0,160,512, 480, 600, 0, 0, 0, 0, 0, 0, 0, 600, 0
! NA PT PR CP CR MT LP GP OP GU DR NA CT SU FE NA
! ABOVE, THE NO OF BYTES FOR LPADAPTORS INCLUDES THE 256 BYTES FOR A
! TRANSLATE TABLE
!***
! USE ENTFORM FROM GDC ***
!***
RECORDFORMAT ENTFORM(INTEGER C
SER, SPSSM, PROPADDR, SECS SINCE, CAA, TCBA, C
BYTEINTEGER MECH,ATTN,HALFINTEGER ALTRT, INTEGER SPARE1, C
STATE, RESP0, RESP1, SENSE1, SENSE2, SENSE3, SENSE4, C
REPSNO, BASE, ID, DLVN, MNEMONIC, C
ENTSIZE, SPARE2, SPARE3, UTCB AD, SENSDAT AD, LOGMASK, TRTAB AD, C
UA SIZE, UA AD, TIMEOUT,PROPS0,PROPS1)
CONSTINTEGER ENT FORM BYTES=128; ! =LENGTH OF ABOVE RECORD FORMAT
! THIS NEXT CONSTANT IS IN WORDS, AND INCLUDES
! LENGTH OF ENTFORM =32
! LENGTH OF DCU'S TCB =14
! TOTAL 46
CONSTINTEGER DEV ENTRY BASIC=46; ! WORDS, SIZE OF FIXED PART OF COMMS AREA RECORD FORMAT
CONSTHALFINTEGERARRAY TIMEOUT SECONDS(0:15)= C
10, 60, 60,600,300, 10, 60, 10, 10, 10, 10, 10, 10, 10, 3, 10
! NA PT PR CP CR MT LP GP OP GU DR NA CT SU FE NA
OWNBYTEINTEGERARRAYFORMAT BIFT(0:511)
OWNBYTEINTEGERARRAYFORMAT LBIFT(0:2047)
OWNINTEGERARRAYFORMAT IFT(0:1023)
CONSTINTEGER MT=5, LP=6, OP=8, FE=14
CONSTINTEGER DISC PCM=9,EDS100=X'33',EDS200=X'35',EDS80=X'37',FDS160=X'39',FDS640=X'3B'
CONSTINTEGER EDS ADAPTOR BYTES=1120; ! 14 TCBs
CONSTINTEGER EDS Q SPACE=32; ! instead of _PROPS0,PROPS1 then:
! PROPS,STATS1,STATS2,bytint QSTATE,PRIO,SP1,SP1, c
! LQLINK,UQLINK,CURCYL,SEMA,TRLINK,SPARE)
CONSTINTEGER REAL0 SEG=X'2040'; ! PUBLIC 64(DEC) MAPPED TO REAL 0
!
!
! ------ IDLES -----
! FF00 TOO MANY DCU'S (>8)
! FF01 TOO MANY SLOTS (>256) OR
! SUPPLIED TABLE TOO SMALL
! FF02 TOO MANY SLOTS ON ONE DCU
! (ARRAY IN THIS RT)
! FF03 TOO MANY MAGTAPE STREAMS (>32)
! (IDLE IN 'FORM TABLES' ABOVE)
!
! FF04 TOO MANY OPER STREAMS (>7)
! (IDLE IN 'FORM TABLES' ABOVE)
! FF05 SUPPLIED TABLE TOO SMALL
! (RT CHECKLIM IN RT FORM TABLES)
! FF06 TCB/SENSDAT
! NOT COMPATIBLE (CHECK ON THIS PROGRAM!)
!
! FF07 DCU ACTIVATE FAILED
!
INTEGER CAA,STRM,RSTRM,TOPSTRM
INTEGER MECH,MPROP,AUTO,FORM STYLE,FORM LEN,NEW CAA
INTEGER I,J,K,L,PT,DCUHN,DCU2,RESP0,RESP1
INTEGER DEV,DACT
INTEGER TABAD,CURNR
INTEGER PROPDATADDR,SENSDATADDR
INTEGER PROPS,PROPS1
INTEGER START STREAM,LAST STREAM
INTEGER AWORDA
INTEGER TCBA
INTEGER CART,A,S
RECORD (TCBF)NAME TCB,TCB2
RECORD (UTEF)NAME UT
INTEGERARRAY ACT(0:1)
LONGINTEGER LA
RECORDFORMAT RF(INTEGER STREAM,RESP0,RESP1,PROPS0,PROPS1, C
SENS0,SENS1,SENS2)
RECORD (RF)NAME R
INTEGERARRAYNAME TABLE
!
!
! BYTE OFFSETS FROM TCB ADDRESS --
CONSTINTEGER PROPDAT OFFSET=X'40'
CONSTINTEGER SENSDAT OFFSET=X'48'
CONSTINTEGER LP REP OFFSET=X'58'
CONSTINTEGER LP4B=X'41'
CONSTINTEGER REMENTSI=8; ! NO OF WORDS REMEMBERED BY 'REMEMBER'
CONSTINTEGER MAXDCUNO=7
CONSTINTEGER CONNECT=0,SENDPROP=X'2C40400E',SENSE=X'2C404004'
CONSTINTEGER INITIALISE=X'2C404081',LOAD REP=X'2C4040A5'
CONSTINTEGER WRITE CONTROL=X'2C404085',READ=X'2C404002'
OWNLONGINTEGER STATUS POLL=X'0016161604212105'
! see PSD 4.2.13 sect. 3.6.4
! only guessing tho!!
CONSTINTEGER TERMINATED=X'10000000'
CONSTINTEGER CR80=X'0C000000'
CONSTINTEGER MAX RESPONSE BYTES=X'C00'; !***PROTEM
!%CONSTINTEGER MAX RESPONSEBYTES=X'1000'; ! LIMIT TO ARRAY RESPONSES
CONSTINTEGER MT6PROP=X'00000100'; ! BIT IN BYTE 2 OF MT PROP CODES
CONSTINTEGER ZX=11; ! dummy device
!
OWNINTEGER SETUP=0
!
! ENOUGH FOR 128 TAPE DECKS @ 8 WORDS EACH
INTEGERARRAYNAME RESPONSES
OWNINTEGER NR
OWNINTEGER TOP TAB ENT
OWNINTEGER DCUNO=-1
OWNINTEGER LHWDCU=MAXDCUNO+1
OWNINTEGER HHWDCU
OWNINTEGER UTAD=UTVA; ! unit table base
OWNINTEGER DDT NO
OWNINTEGER LP INIT WORD=0
OWNINTEGER SPARE SLOT
! G2NEXT IS INCREMENTED AT EACH DACT=2 ENTRY TO DCU GROPE.
! G2ZERO GIVES THE ORIGINAL VALUE, IE. THESE TWO MUST START OFF THE SAME.
CONSTINTEGER G2ZERO=8
OWNINTEGER G2NEXT=8; ! TABLE ENTRY AT WHICH FINAL C/A ADDRS START
!
SWITCH GROPE(1:3)
SWITCH GDEV(0:15)
!* P_P1 :- %BYTEINTEGER STRMS,CCA SEG,DCU NO.,SCU PORT
!* DCU2s have STRMS zero
!*
RESPONSES==ARRAY(REAL0 SEG<<18 + X'2000',IFT)
DACT=P_DEST&X'FFFF'
UNLESS 0<DACT<=3 THEN ->OUT
TABAD=P_P2
TABLE==ARRAY(TABAD,IFT)
IF SETUP=0 START
SETUP=1
CYCLE J=0,1,MAX RESPONSEBYTES>>2-1
RESPONSES(J)=X'88888888'
REPEAT
FOR J=0,1,15 CYCLE
REPERTOIRE ADDR(J) = ADDR(LP96REP(0))
REPERTOIRE LEN(J) = 96
REPEAT
REPERTOIRE ADDR(3) = ADDR(LP384REP(0))
REPERTOIRE LEN(2) = 48
REPERTOIRE LEN(3) = 384
REPERTOIRE LEN(4) = 64
TABLE(0)=47
TABLE(1)=48; ! start of DCU table
TABLE(2)=-1; ! no. of slots
TABLE(3)=0; ! no. of DCUs
FINISH
PT=P_P1&255
IF P_P1>>24=0 THEN DCU2=YES ELSE DCU2=NO AND AWORDA=X'60000000'!PT<<22
DCUHN=P_P1>>8&15
-> GROPE(DACT)
!*
GROPE(1): ! initailise & grope
!*
CAA=P_P3
TOP TAB ENT=P_P4
DCUNO=DCUNO+1
IF DCUNO>MAXDCUNO START
*IDLE_X'FF00'
FINISH
TABLE(3)=TABLE(3)+1
TCBA=CAA+32
TCB==RECORD(TCBA)
TCB=0
PROPDATADDR=TCBA+PROPDAT OFFSET
SENSDATADDR=TCBA+SENSDAT OFFSET
IF DCU2=YES START
START STREAM=1
LAST STREAM=255
TABLE(24+DCUNO)=32; ! no CCA required
FINISH ELSE START
ACT(0)=X'1400'; !temp CCA
ACT(1)=REALISE(TCBA&X'FFFC0000')!X'80000001'
J=0
I=PINT AND J=J+1 UNTIL I=0 OR J=100; !lose outstanding ints.
LA=LONGINTEGER(ADDR(ACT(0)))
*LSD_LA; *LB_AWORDA; *ADB_X'20'; *ST_(0+B ); ! set CCA
J=P_P5+8+(P_P1&X'FF')*8; !DCU table
J=P_P5+INTEGER(J+4)&X'FFFF'; !stream tables
START STREAM=BYTEINTEGER(J+7)
LAST STREAM=START STREAM+BYTEINTEGER(J+6)
TABLE(24+DCUNO)=32+32*P_P1>>24*4
FINISH
TABLE(16+DCUNO)=DCUHN
LHWDCU=DCUHN IF DCUHN<LHWDCU
HHWDCU=DCUHN IF HHWDCU<DCUHN
! field SYSERRs during grope (usually DCU failures)
*LSS_(3); *USH_-26; *AND_3; *ST_I
IST==RECORD(X'80000000'!I<<18)
SAVE IST=IST
*JLK_<SYSERR>; *LSS_TOS ; *ST_I
IST_PC=I
IST_SSR=X'0180FFFE'
*STLN_I; IST_LNB=I
*STSF_I; IST_SF=I
RETRY REPORTING(-1); ! retry reporting on
STRM=START STREAM
MECH=0
SPARE SLOT=0
UNTIL STRM>LAST STREAM CYCLE
CURNR=NR
IF DCU2=YES START
UT==RECORD(UTAD); ! set up unit entry
UT=0
UT_PD=X'E7000000'
UT_FMN=PT
UT_STRM=STRM
UT_FLAGS=X'81'
UT_IDEST=X'000E4000'; ! peri -> unit
DO(X'2C41400E',PROPDATADDR,8); ! send stream props
IF RESP0>>30=3 THEN ->NEXT STREAM; ! fire fails
IF DEV>>4=0 THEN ->NEXT STREAM; ! non-existent stream
IF DEV>>4=1 THEN EXIT ; ! no more streams
FIRE IO(0,1); ! reserve stream
IF TCB_RESP>>30=3 THEN ->NEXT STREAM; ! reserve fails
J=0
I=PINT AND J=J+1 UNTIL I#0 OR J>100
DO(SENDPROP,PROPDATADDR,8); ! send device props
IF RESP0=0 OR RESP0>>30=3 THEN ->NODEV
DO(SENSE,SENSDATADDR,12)
IF RESP0=0 OR RESP0>>30=3 THEN ->NODEV
RESP1=UTAD; ! save UT AD
FINISH ELSE START
DO(CONNECT,0,0)
DO(SENDPROP,PROPDATADDR,8) UNLESS DEV=-1
DO(SENSE,SENSDATADDR,12) UNLESS DEV=-1 OR RESP0=0
FINISH
IF DEV=DISC PCM START
I=BYTEINTEGER(PROPDATADDR+2)
UNLESS I=0 START
INTEGER(PROPDATADDR+4)=0; ! lest alternate route
IF I=EDS100 OR I=EDS200 THEN DEV=I ELSE START
! EDS80 family identified thus:-
! n2 = FDS640
! n3 = FDS160
! n8 = EDS80
! where n = 4 for single channel & n = C for dual channel
IF I>>7#0 START ; ! dual channel
J=0
WHILE J<NR CYCLE ;! find other interface
R==RECORD(ADDR(RESPONSES(J)))
IF EDS80<=R_PROPS0>>24<=FDS640 START
IF INTEGER(PROPDATADDR)>>8&X'FFFF'=R_PROPS0>>8&X'FFFF' START
R_PROPS1=PT<<8!STRM; ! remember alternate route
->NODEV
FINISH
FINISH
J=J+REMENTSI
REPEAT
FINISH
I=I&15
IF I=8 THEN DEV=EDS80 ELSE C
IF I=3 THEN DEV=FDS160 ELSE DEV=FDS640
FINISH
BYTEINTEGER(PROPDATADDR)=DEV
FINISH ELSE DEV=-1
FINISH
->DDEV IF EDS100<=DEV<=FDS640
->NODEV UNLESS 0<=DEV<=15
->NODEV IF DEV=12; ! forget comms lines
FORGETMENOT
->GDEV(DEV)
GDEV(6): !LINE PRINTER
UNLESS PROPS>>8&LP4B=0 START
IF DCU2=YES THEN UTAD=UTAD-64; ! further I/Os required so step
! back to right UTAD
! (FORGETMENOT updates it)
FORM STYLE=PROPS&255
FORM LEN=(FORM STYLE>>4)*10+FORM STYLE&15
FORM LEN=66 IF FORM LEN=0
CART=PROPS1>>16&15
A=REPERTOIRE ADDR(CART)
S=REPERTOIRE LEN(CART)
I=0
WHILE I<384 CYCLE ; ! fill the repertoire buffer
J=A
WHILE J<A+S CYCLE
INTEGER(CAA+LP REP OFFSET+I)=INTEGER(J)
I=I+4; J=J+4
REPEAT
REPEAT
INVALIDATE(CURNR)
LP INITWORD=X'10'
DO(INITIALISE,ADDR(LP INITWORD),4)
UNLESS CART=0 AND PROPS1&X'100000'=0 THEN C
DO(LOADREP,CAA+LP REP OFFSET,384)
LP INIT WORD=X'FC10'
DO(INITIALISE,ADDR(LP INIT WORD),4)
LP INIT WORD=(FORMLEN-1)<<24
DO(WRITE CONTROL,ADDR(LP INIT WORD),1) UNLESS FORM LEN=99
DO(SENDPROP,PROPDATADDR,8)
DO(SENSE,SENSDATADDR,12)
IF DCU2=YES THEN RESP1=UTAD; ! dont forget UTAD
FORGETMENOT
FINISH
->NEXT STREAM
SYSERR: ! report error & terminate grope on this DCU
*JLK_TOS
*LSS_TOS ; *LSS_TOS ; *ST_I
OPMESS("DCU ".HTOS(DCUHN,2)." SEI ".HTOS(I,8).TOSTRING(17))
EXIT
NODEV: ! invalid devices
IF DCU2=YES START
FIRE IO(0,5); ! release stream
J=0
I=PINT AND J=J+1 UNTIL I#0 OR J>100
FINISH
->NEXT STREAM
DDEV: !DISCS
RESP0=X'18400000'; ! cannot fail now
FORGETMENOT
NDISCS=NDISCS+1
->NEXT STREAM
GDEV(12): ! communications line
->NEXT STREAM
GDEV(0):GDEV(1):GDEV(2):GDEV(3):GDEV(4):GDEV(5):GDEV(7):GDEV(8):
GDEV(9):GDEV(10):GDEV(11):GDEV(13):GDEV(14):GDEV(15):
NEXT STREAM:
STRM=STRM+1
REPEAT
IST=SAVE IST
RETRY REPORTING(0); ! retry reporting off
J=0
I=PINT AND J=J+1 UNTIL I=0 OR J>100; ! lest any abterms lurking
->OUT
!*
GROPE(3): ! form GDC table
! P_P2 = address of TABLE
!*
J=0
TOPSTRM=-1
WHILE J<NR CYCLE
R==RECORD(ADDR(RESPONSES(J)))
RSTRM=R_STREAM
IF RSTRM>>30#0 THEN ->NEXTR; !INVALIDATED
IF R_RESP0=-1 THEN ->NEXTR; !CONNECT FAILED
MPROP=R_PROPS0
IF MPROP=0 THEN ->NEXTR; !NO PROP CODES
DEV=MPROP>>24
IF DEV=0 THEN ->NEXTR
IF R_RESP0&TERMINATED=0 THEN ->NEXTR
!* SAID TO EXCLUDE 7905 !
IF DEV=MT AND R_RESP0&CR80=0 THEN ->NEXTR
!* SHOULD EXCLUDE HANS CHRISTIAN ANDERSON!
!* (NO "SHORT BLOCK" ON 12 BYTE SENSE)
IF DEV=MT THEN MPROP=MPROP&X'FFF0FFFF'; ! ensure mech 0
AUTO=MPROP
TOPSTRM=RSTRM>>8&X'FF'; !HIGHEST STREAM SO FAR
NEW ENTRY(DEV,RSTRM,MPROP,R_PROPS1,AUTO)
IF DEV=MT START
K=3; !3 MORE SLOTS FOR MT4
K=7 IF R_PROPS0&MT6PROP#0; !7 MORE FOR MT6
CYCLE L=1,1,K
RSTRM=RSTRM+1
MPROP=MPROP+X'10000'
NEW ENTRY(DEV,RSTRM,MPROP,R_PROPS1,MPROP)
REPEAT
FINISH
R_STREAM=RSTRM!X'40000000'; !PREVENT 2ND INSPECTION
NEXTR:
J=J+REMENTSI
REPEAT
FORM TABLES(TABAD,TOP TAB ENT)
-> OUT
!*
GROPE(2): ! FORMAT CA'S
! P_P2 IS TABLE ADDRESS
! P_P3 IS VIRTUAL ADDRESS OF OLD C/A SEGMENT
! P_P4 IS VIRTUAL ADDRESS OF NEW C/A SEGMENT
! P_P6 = ADDR(TEMP DDT POINTER AREA
NEW CAA=P_P4
TABLE(G2NEXT)=NEW CAA
IF G2NEXT=G2ZERO START ; ! init operlog
TABLE(41)=TABLE(41)+NEW CAA
INIT RES PIC(TABLE(41),48*41)
FINISH
FORMAT COMMS AREA(TABAD,G2NEXT - G2ZERO,NEW CAA)
G2NEXT=G2NEXT + 1
->OUT
OUT:
P_P1=0
RETURN
ROUTINE FIRE IO(INTEGER PORT,LONGINTEGER ACT)
INTEGER ACTW
INTEGER I
LONGINTEGER TCB DESC,UT DESC
IF DCU2=YES START
TCB DESC=TCBA&X'0FFFFFFFF'!LENGTHENI(X'2800000E')<<32
UT DESC=UTAD&X'0FFFFFFFF'!LENGTHENI(X'B0000001')<<32
*PRCL_4
*LSS_ACT+4
*SLSD_TCB DESC
*ST_TOS
*LD_UT DESC
*RALN_8
*CALL_(DR )
*ST_I
IF I#0 THEN TCB_RESP=X'C0000000'!I; ! fire failed
FINISH ELSE START
I=PINT
ACTW=X'60000000'!PORT<<22
*LB_ACTW
*LSD_ACT
*ST_(0+B )
ACTOK:
*MPSR_X'12'
*L_(0+B )
*MPSR_X'11'
*JAF_4,<ACTOK>
FINISH
END
ROUTINE FORM TABLES(INTEGER TABAD,TOP TAB ENT)
!-----------------------------------------------------------------------
! FORMAT OF TABLE IS
! +=ALREADY SET UP
! WORD
! + 0 LAST WORD CURRENTLY USED
! + 1 POINTER TO SLOT TABLE
! + 2 'LASTSLOT' NUMBER
! + 3 NUMBER OF DCU'S
! 4 WORD WHERE STRMQ ARRAY STARTS
! 5 DCU & STREAM TO SLOT (SPSS)
! 6 HDCU TO LDCU
! 7 (MAG TAPES) MECHINDEX
! + 8-15 C/A ADDRESSES FOR DCU'S 0-7
! + 16-23 H/W DCU NO. FOR DCU'S 0-7
! + 24-31 C/A SIZES (BYTES) REQD FOR DCU'S 0-7
! 32-39 STARTS AND LIMITS OF OPER BUFFERS IN COMMS AREA
! FOR OPER STREAMS 0-6 (SUCCESSIVE OPER STREAMS AS FOUND
! IN DCU TABLE).
! LH HALFWORD = OFFSET FROM RELEVANT COMMS AREA
! RH HALFWORD = NO OF BYTES ALLOCATED.
! 40 ADDRESS OR START OR TABLE AREA FOR TAPE ROUTINE
! RELATIVE TO START OF FIRST COMMS AREA. THIS AREA IS AT THE
! BACK OF THE COMMS AREA FOR DCU0, FOLLOWING THE OPER
! BUFFERS(IF ANY).
! 41 SPARE (FOR FEP OR EQUIVALENT)
! 42 SPARE
! 43-46 GROPE VSN (STRING)
! 47 SPARE
!
! THEN FOLLOW:
! DCU TABLE
! STRMQ
! DCU & STREAM TO SLOT (SPSS)
! HDCU TO LDCU
! MECHINDEX
!------------------------------------------------------------------------
!
INTEGER NOPERSTRMS,PROP,OPERBYTES,CUR OFF,MAGSLOTS
INTEGER NDCUS,J,N,LOSPSS,HISPSS,TAD,TEND,DCUT BASE,SLOTNO,MECH
INTEGER LASTSLOT,SPSS,I,MBASENO,STRM,DCUNO
!
ROUTINESPEC CHECKLIM(INTEGER WORDS REQ)
BYTEINTEGERARRAYNAME SPSS TO SLOT
BYTEINTEGERARRAYNAME HDCU TO LDCU
BYTEINTEGERARRAYNAME MECHSLOTS
INTEGERARRAYNAME TABLE
RECORD (DCUTF)NAME G
INTEGERNAME CA SIZE
!
TABLE==ARRAY(TABAD,IFT)
NDCUS=TABLE(3)
INTEGERARRAY GS TO MI(0:NDCUS*256); !256 WORDS/DCU
!
! STRMQ - NEED 64 WORDS PER DCU
N=TABLE(0)
TABLE(4)=N+1; ! START ENTRY IN TABLE OF STRMQ ARRAY
J=1
WHILE J<=NDCUS<<6 CYCLE
TABLE(N+J)=X'FFFFFFFF'
CHECKLIM(1)
J=J+1
REPEAT
!
! SPSS TO SLOT
N=TABLE(0)+1
LOSPSS=LHWDCU<<8; ! EG. X'0500' FOR SCU 0 DCU 5
HISPSS=HHWDCU<<8!255
TAD=ADDR(TABLE(N)); ! ADDRESS OF START OF SPSS TO SLOT ARRAY
TABLE(5)=N; ! START ENTRY IN TABLE OF DITTO
TEND=TAD + HISPSS - LOSPSS; ! ADDRESS OF LAST BYTE OF SPSS ARRAY
CYCLE J=TAD,1,TEND
BYTEINTEGER(J)=255; ! SET=UNUSED
REPEAT
J=(HISPSS-LOSPSS+1)>>2
CHECKLIM(J)
DCUT BASE=ADDR(TABLE(TABLE(1)))
LASTSLOT=TABLE(2)
SPSS TO SLOT==ARRAY(TAD,LBIFT)
!
! (FOR MULTI-MECHANISM STREAMS, THE ENTRY WOULD BE SET UP
! - HENCE THE TEST, AT THE ASSIGNMENT TO SPSS TO SLOT, BELOW).
SLOTNO=0
WHILE SLOTNO<=LASTSLOT CYCLE
G==RECORD(DCUT BASE + SLOTNO*SLOTSI)
SPSS=G_SPSSM
MECH=SPSS&15
SPSS=SPSS>>8&X'FFFF'
SPSS TO SLOT(SPSS - LOSPSS)<-SLOTNO C
IF SPSS TO SLOT(SPSS-LOSPSS)=255
SLOTNO=SLOTNO + 1
REPEAT
!
! HDCU TO LDCU
N=TABLE(0)+1
TABLE(6)=N
HDCU TO LDCU==ARRAY(ADDR(TABLE(N)),BIFT)
!* ONE BYTE PER DCU - INDEXED BY (H/W DCU NO. - LOWEST H/W DCU NO.)
!* TO GIVE LOGICAL DCU NO.
J=HHWDCU
CHECKLIM(J)
J=0
WHILE J<=NDCUS-1 CYCLE
HDCU TO LDCU(TABLE(16+J)-LHWDCU)=J
! HOLES IN THIS ARRAY WILL BE LEFT UNASSIGNED
J=J+1
REPEAT
!
!-----------------------------------------------------------------------
! THE (MAG TAPES) MECHINDEX ARRAY.
! EACH TAPE STREAM HAS AN EIGHT-BYTE ENTRY IN THIS ARRAY.
! EACH MAG TAPE SLOT CONTAINS THE ENTRY NUMBER FOR ITS STREAM
! (G_MECHINDEX). BYTE N OF THE ENTRY CONTAINS THE SLOT NUMBER
! FOR MECHANISM N.
!
SLOTNO=0
N=0
MAGSLOTS=0
CYCLE J=0,1,NDCUS*256; GS TO MI(J)=255; REPEAT
! FIRST LOOK THROUGH ALL THE SLOTS LOOKING FOR MAG TAPES. IN GS TO MI,
! INDEXED BY (DCUNO<<8+STRM), FOR EACH DISTINCT STREAM WE PUT AN ENTRY
! NUMBER IN THE MECHSLOTS ARRAY TO BE CREATED. AND N COUNTS THE NUMBER
! OF DISTINCT MAG TAPE STREAMS.
! ALSO COUNT THE NUMBER OF MAGNETIC TAPE SLOTS, TO ALLOCATE SPACE (AT
! 172 BYTES PER SLOT) FOR THE TAPE ROUTINE.
WHILE SLOTNO<=LASTSLOT CYCLE
G==RECORD(DCUT BASE + SLOTNO*SLOTSI)
IF G_DEVTYPE=MT START
MAGSLOTS=MAGSLOTS + 1
DCUNO=(G_SPSSM>>24)&15
STRM=(G_SPSSM>>8)&255
I=DCUNO<<8 + STRM
IF GS TO MI(I)=255 START
GS TO MI(I)=N
N=N+1
FINISH
FINISH
SLOTNO=SLOTNO + 1
REPEAT
IF N>32 START ; *IDLE_X'FF03'; FINISH
! N IS THE NUMBER OF MAG TAPE STREAMS. AT 2 WORDS PER STREAM
! NOW FOR EACH MAG TAPE HANDLER, WE FIND THE 'BASE' IN MECHSLOTS FOR
! ITS STREAM FROM GS TO MI AND PUT THE SLOT NUMBER INTO THE MECHSLOTS
! ENTRY FOR THAT STREAM.
I=TABLE(0)+1
TABLE(7)=I
CHECKLIM(N<<1)
J=I
WHILE J<I+N<<1 CYCLE ; TABLE(J)=X'FFFFFFFF'; J=J+1; REPEAT
MECHSLOTS==ARRAY(ADDR(TABLE(I)),BIFT)
SLOTNO=0
WHILE SLOTNO<=LASTSLOT CYCLE
G==RECORD(DCUT BASE + SLOTNO*SLOTSI)
IF G_DEVTYPE=MT START
DCUNO=(G_SPSSM>>24)&15
STRM=(G_SPSSM>>8)&255
I=DCUNO<<8 + STRM
MBASENO=GS TO MI(I)<<3
MECH=G_SPSSM&15
MECHSLOTS(MBASENO+MECH)=SLOTNO
G_MECHINDEX=MBASENO
FINISH
SLOTNO=SLOTNO + 1
REPEAT
!---------------- SPACE ALLOCATION IN COMMS AREAS ------------------------
!
! NOW BASIC AOMUNT FOR EACH DEVICE, PLUS WORK AREAS FOR DEVICE ADAPTORS, ACCORDING TO ARRAY ADAPTOR BYTES.
SLOTNO=0
WHILE SLOTNO<=LASTSLOT CYCLE
G==RECORD(DCUT BASE + SLOTNO*SLOTSI)
DCUNO=(G_SPSSM>>24)&15
CA SIZE==TABLE(24+DCUNO)
CA SIZE=(CA SIZE+7) & (¬7); ! EACH AREA TO BE DOUBLE-WORD ALIGNED
CA SIZE=CA SIZE+DEV ENTRY BASIC<<2
IF G_DEVTYPE>15 THEN I=EDS ADAPTOR BYTES+EDS Q SPACE ELSE C
I=ADAPTOR BYTES(G_DEVTYPE)
CA SIZE=CA SIZE+I
SLOTNO=SLOTNO + 1
REPEAT
!
! NOW CALCULATE SPACE REQUIRED FOR THE OPER BUFFERS,CURRENTLY
! 576 BYTES PLUS 984 BYTES PER SCREEN (IF MORE THAN ONE SCREEN, LEAVE
! SPACE FOR 6). THUS
! ONE SCREEN 1560 BYTES (X618)
! MORE THEN ONE SCREEN 6480 BYTES (X1950)
NOPERSTRMS=0
SLOTNO=0
WHILE SLOTNO<=LASTSLOT CYCLE
G==RECORD(DCUT BASE + SLOTNO*SLOTSI)
IF G_DEVTYPE=OP START ; ! OPER
! +++++++++++++++++++++++++++++++++++++++FF04
IF NOPERSTRMS>=7 START ; *IDLE_X'FF04'; FINISH ; ! TOO MANY
PROP=G_MECHINDEX
G_MECHINDEX=G_MECHINDEX ! (NOPERSTRMS<<4)
OPERBYTES=1560; ! ONE SCREEN ONLY
IF PROP&15>1 THEN OPERBYTES=6480; ! MORE THAN ONE SCREEN
! ALLOCATE SPACE NOW IN COMMS AREA FOR THIS DCU. THIS INVOLVES ADDING
! TO TABLE(24+DCUNO).
DCUNO=(G_SPSSM>>24)&15
CUR OFF=TABLE(24+DCUNO)
TABLE(32+NOPERSTRMS)=CUR OFF<<16 + OPERBYTES
! INCREASE C/A SIZE REQUIRED
TABLE(24+DCUNO)=CUR OFF + OPERBYTES
NOPERSTRMS=NOPERSTRMS + 1
FINISH
SLOTNO=SLOTNO + 1
REPEAT
!-----------------------------------------------------------------------
! AND NOW THE SPACE AT THE BACK OF THE FIRST COMMS AREA
! 1. FOR THE TAPE TABLE
! 2. SPARE (EX FEP)
!
! RELATIVE ADDRESS OF TAPE TABLE AREA = CURRENT SIZE (BYTES) OF COMMS AREA :
TABLE(40)=TABLE(24)
! INCREASE 'SIZE REQUIRED', FOR FIRST COMMS AREA, AT 172+64=236 BYTES PER
! MAG TAPE SLOT, WITH AN EXTRA 256-64=192 BYTES FOR EACH OF THE FIRST TWO STREAMS
TABLE(24)=TABLE(24) + 236*MAGSLOTS
J=MAGSLOTS
J=2 IF J>2
TABLE(24)=TABLE(24) + J*192
! ***** FOLLOWING FEW LINES LEFT IN FOR INFO (EX FEP)
! WORK AREA FOR LINK AND FOR FE ADAPTOR. 512 BYTES EACH, AND CONTIGUOUS,
! IN FACT. TABLE(41) TO MARK START OF THE PAIR OF AREAS, 2ND TO BE
! 512 BYTES ON FROM FIRST.
! TABLE(24)=(TABLE(24)+7) & (¬7); ! LINK AREA TO BE DOUBLE-WORD ALIGNED
! TABLE(41)=TABLE(24); ! REL START (BYTES) OF WORK AREA FOR LINK
! TABLE(24)=TABLE(24) + 1024; ! 512 BYTES FOR EACH
! TABLE(42)=TABLE(24); ! LIMIT FOR LINK WORK AREA (REL TO C/A)
! TEMP COMPAT
TOPSTRM=255
! ALLOCATE MAX OF THAT REQD FOR SLOTS AND X40 BYTES FOR STREAMS ZERO
! TO HIGHEST STREAM FOUND (NEW SCHEME)
DCUNO=0
WHILE DCUNO<NDCUS CYCLE
J=TABLE(24+DCUNO)
K=(TOPSTRM+1)<<6 + X'120'
IF K>J THEN TABLE(24+DCUNO)=K
DCUNO=DCUNO+1
REPEAT
J=TABLE(24); ! allocate operlog space
J=(J+3)&(-4); ! in 1st comms area
TABLE(41)=J
TABLE(24)=J+1976
RETURN
ROUTINE CHECKLIM(INTEGER WORDS REQ)
! +++++++++++++++++++++++++++++++++++++++++FF05
IF TABLE(0)+WORDS REQ>TOP TAB ENT START
*IDLE_X'FF05'
FINISH
TABLE(0)=TABLE(0) + WORDS REQ
END ; ! CHECKLIM
END ; ! FORM TABLES
ROUTINE FORMAT COMMS AREA(INTEGER TABAD,DCUNO,CAA)
! CALLED ONCE FOR EACH COMMS AREA AFTER AREA HAS BEEN ALLOCATED
! (IE. AT DACT=2 ENTRY TO DCU GROPE).
INTEGER LASTSLOT,J,SLOTNO,DCUT BASE, DEV OFFSET,DEV ENT BASE
INTEGER REPAD,REPLEN,CH,IX,DEVTYPE,GNO,EDS EXTRA
LONGINTEGER A
CONSTINTEGER EDS TIMEOUT=3
CONSTINTEGER HL=32; !CA HEADER LENGTH
CONSTINTEGER LP ILLCHAR=X'07'
!
RECORD (ENTFORM)NAME D
RECORD (DCUTF)NAME G
!
BYTEINTEGERARRAYNAME REP,TRTAB
INTEGERARRAYNAME TABLE
INTEGERARRAYNAME DDTP
!
RECORDFORMAT CAHF(INTEGER ACTW,SEMA)
RECORD (CAHF)NAME CAH
RECORD (TCBF)NAME DCUS TCB
CAH==RECORD(CAA)
CAH_ACTW=AWORDA; !DCU INT/ACT WORD ADDRESS
CAH_SEMA=-1; ! multi ocp semaphore
IF DCU2=YES THEN ->SKIP
J=REALISE(CAA); !SET DCU CCA
A=LENGTHENI(J+HL)<<32!J!X'080000001'
J=P_P1>>24; !NO. OF STREAMS
J=(J+3)&(-4)//4
J=0 IF J>15
A=A!LENGTHENI(J<<28)<<32
*LSD_A
*LB_AWORDA
*ADB_X'20'
*ST_(0+B )
SKIP:
TABLE==ARRAY(TABAD,IFT)
DDTP==ARRAY(P_P6,IFT)
LASTSLOT=TABLE(2)
DCUT BASE=ADDR(TABLE(TABLE(1)))
SLOTNO=0
DEV OFFSET=HL+32*P_P1>>24*4; !HEADER + DCU CCA SIZE
WHILE SLOTNO<=LASTSLOT CYCLE
G==RECORD(DCUT BASE + SLOTNO*SLOTSI)
GNO=(G_SPSSM>>24) & 15
IF GNO=DCUNO START
! IF THE SLOT RELATES TO THIS DCU (IE. THIS COMMS AREA) THEN
! FORMAT THE DEVICE ENTRY.
DEVTYPE=G_DEVTYPE
IF EDS100<=DEVTYPE<=FDS640 THEN EDS EXTRA=EDS Q SPACE C
ELSE EDS EXTRA=0
DEV ENT BASE=CAA + DEV OFFSET
D==RECORD(DEV ENT BASE)
G_DEV ENT BASE=DEV ENT BASE
D_SPSSM=G_SPSSM
D_PROPS0=G_PROPS0
D_PROPS1=G_PROPS1
UNLESS EDS EXTRA=0 THEN D_ALTRT<-G_PROPS1; ! alternate route
D_PROPADDR=ADDR(D_PROPS0)
D_CAA=CAA
D_TCBA=DEV ENT BASE + ENT FORM BYTES+EDS EXTRA
D_MNEMONIC=G_MNEMONIC
D_LOGMASK=1 IF DEVTYPE#MT AND DEVTYPE#LP
D_SENSDAT AD=ADDR(D_SENSE1)
D_TIMEOUT=EDS TIMEOUT
D_TIMEOUT=TIMEOUT SECONDS(DEVTYPE) UNLESS DEVTYPE>15
DCUS TCB==RECORD(D_TCBA)
DCUS TCB=0
DCUS TCB_COMMAND=X'2F00400A'; ! set up IDENTIFY
DCUS TCB_STE=REALISE(ADDR(D)&X'FFFC0000')!1
DCUS TCB_LEN=2
DCUS TCB_DATA=ADDR(D_MECH)
!-------------------------------------------------
D_UA AD=DEV ENT BASE + DEV ENTRY BASIC<<2+EDS EXTRA
IF EDS EXTRA=0 THEN D_UA SIZE=ADAPTOR BYTES(DEVTYPE) C
ELSE D_UA SIZE=EDS ADAPTOR BYTES
D_ENT SIZE=DEV ENTRY BASIC<<2 + D_UA SIZE
UNLESS EDS EXTRA=0 START
DDTP(DDT NO)=DEV ENT BASE
DDT NO=DDT NO+1
D_PROPADDR=(DEVTYPE-EDS100)*20
FINISH
IF DEVTYPE=LP START
D_UA SIZE=D_UA SIZE - 256; ! TAKE OFF SIZE OF TRANSLATE TABLE
D_TRTAB AD=D_UA AD + D_UA SIZE
TRTAB==ARRAY(D_TRTAB AD,BIFT)
CART=G_PROPS1>>16&15
! create the translate table, based on the repertoire
IF CART=0 OR BYTEINTEGER(D_PROPADDR+2)&LP4B=0 START
FOR IX=0,1,255 CYCLE ; TRTAB(IX)=IX; REPEAT
FINISH ELSE START
REPAD=REPERTOIRE ADDR(CART)
REP==ARRAY(REPAD,BIFT)
REPLEN=REPERTOIRE LEN(CART)
FOR IX=0,1,255 CYCLE
CH=LP ILLCHAR; ! del (07) for ERCC, UKC may use back '?'
J=0
WHILE J<REPLEN CYCLE
IF IX=REP(J) THEN CH=IX AND EXIT
J=J+1
REPEAT
! insert 'format effectors' at own values
! and also turn lf (x'25') into newline (x'15')
IF IX=X'15' THEN CH=X'15'
IF IX=X'25' THEN CH=X'15'
IF IX=X'0C' THEN CH=X'0C'; ! NEWLINE
IF IX=X'0D' THEN CH=X'0D'
IF IX=X'40' THEN CH=X'40'; ! SPACE
! If value IX was not found in repertoire (CH still LP ILLCHAR),
! was it a lower case letter? If so, change it to upper case.
! (We do not search to see if the upper case letter is in the
! repertoire (surely it is)).
IF CH=LP ILLCHAR AND C
(X'81'<=IX<=X'89' OR X'91'<=IX<=X'99' OR C
X'A2'<=IX<=X'A9') THEN CH=IX ! X'40'
TRTAB(IX)=CH
REPEAT
FINISH ; ! cartridge setting non-zero
FINISH ; ! LP DEVICE
DEV OFFSET=DEV OFFSET + D_ENT SIZE
FINISH ; ! SLOT BELONGS TO THIS DCU
SLOTNO=SLOTNO+1
REPEAT
END ; ! FORMAT COMMS AREA
!
ROUTINE DO(INTEGER COMMAND,DATAD,LEN)
INTEGER I,J
LONGINTEGER A
CONSTINTEGER CONNECT STREAM=X'03000000',START STREAM=X'01000000'
CONSTINTEGER CONNECT TERM=X'201000'
A=LENGTHENI(TCBA)<<32!STRM
IF COMMAND=0 START ; !CONNECT STREAM
A=A!CONNECT STREAM
FIRE IO(PT,A)
CYCLE J=0,1,5; !WAIT FOR TERMINATION
I=PINT; ! take interrupt
IF I>>24=DCUHN&15 AND I&X'FF'=STRM C
AND I&CONNECT TERM=CONNECT TERM START
DEV=0
RETURN
FINISH
REPEAT
DEV=-1
RETURN
FINISH
A=A!START STREAM
IF DCU2=YES THEN A=2
TCB_COMMAND=COMMAND
TCB_STE=REALISE(DATAD&X'FFFC0000')!1
TCB_LEN=LEN
TCB_DATA=DATAD
TCB_RESP=0
FIRE IO(PT,A)
J=0
J=J+1 UNTIL TCB_RESP#0 OR J>100000
RESP0=TCB_RESP
IF DCU2=NO THEN RESP1=0
IF INTEGER(PROPDATADDR)=0 AND SPARE SLOT=0 START ; ! set up spare slot
SPARE SLOT=1
INTEGER(PROPDATADDR)=ZX<<24
RESP0=X'1000'
FINISH
DEV=INTEGER(PROPDATADDR)>>24
END ; ! DO
ROUTINE FORGETMENOT
INTEGER I
I=DCUNO<<24!DCUHN<<16!STRM<<8!MECH
REMEMBER(I)
REMEMBER(RESP0)
REMEMBER(RESP1)
PROPS=INTEGER(PROPDATADDR)
PROPS1=INTEGER(PROPDATADDR+4)
REMEMBER(PROPS)
REMEMBER(PROPS1)
RESP0=0
LONGINTEGER(PROPDATADDR)=0
CYCLE I=0,4,8
REMEMBER(INTEGER(SENSDATADDR+I))
INTEGER(SENSDATADDR+I)=-1
REPEAT
IF DCU2=YES THEN UTAD=UTAD+64; ! next UT entry
END
ROUTINE INVALIDATE(INTEGER ENT)
RESPONSES(ENT)=RESPONSES(ENT) ! X'80000000'
END ; ! INVALIDATE
ROUTINE NEW ENTRY(INTEGER DEVTYPE,GSPSSM,PROPS0,PROPS1,AUTO)
OWNINTEGERARRAY MNEMONIC(1:15)= C
M'PT0', M'PR0', M'CP0', M'CR0', M'M00',
M'LP0', M'GP0', M'OP0', M'GU0', M'DR0',
M'ZX0', M'CT0', M'SU0', M'FE0', M'LK0'
! THE TCBS ARRAY IS INDEXED BY DEVTYPE AND SPECIFIES THE NUMBER
! OF TCB'S TO BE ASSIGNED TO EACH DEVICE TYPE.
RECORD (DCUTF)NAME G
INTEGER NEXT,MD,STRM
NEXT=TABLE(0) + 1
G==RECORD(ADDR(TABLE(NEXT)))
G_DEVTYPE=DEVTYPE
G_SPSSM=GSPSSM
! SUPPLY LAST BYTE OF PROP CODES FOR OPER ONLY
IF DEVTYPE=OP THEN G_MECHINDEX<-PROPS0
! FIGURE OUT MNEMONIC. CURRENT ARRAY ENTRIES HOLD THE
! MNEMONICS NEXT TO BE USED. FOR NON-MAG TAPES, AND FOR MAG TAPES
! ON THE SAME STREAM AS PREVIOUS ONE (IF ANY), JUST USE THE ARRAY
! ENTRY AND INCREMENT IT.
! FOR A MAG TAPE, WE USE THE TAPE HANDLER (WIRED, UNIQUE) ADDRESS
! OUT OF BYTE ONE (0-1-2-3) OF THE PROPERTY CODES
! SIMILAR ARRANGEMENT FOR DISCS
IF DEVTYPE>15 START
IF DEVTYPE<FDS160 THEN MD=M'ED' ELSE MD=M'FD'
MD=MD<<16!HEXDS(PROPS0>>20&15)<<8!HEXDS(PROPS0>>16&15)
FINISH ELSE MD=MNEMONIC(DEVTYPE)
STRM=(GSPSSM>>8) & 255
! 'M' PLUS BOTTOM 7 BITS OF BYTE 1 OF PROPERTY CODES AS 2 ISO CHARS, FOR MT
IF DEVTYPE=MT THEN MD=PROPS0<<9>>29<<8 + PROPS0<<12>>28 + M'M00'
IF DEVTYPE=FE START
MD=PROPS0<<8>>24
FEP MAP=FEP MAP!1<<MD
MD=MD+M'FE0'
FINISH
G_MNEMONIC=MD
G_PROPS0=PROPS0
G_PROPS1=PROPS1
G_PROPS03<-AUTO; ! THIS IS BYTE 3 OF PROPS, EXCEPT FOR LP, WHEN
! IT'S 1ST TERTIARY STATUS BYTE (CONTAINING AUTO BIT)
G_UTAD=R_RESP1; ! 0 or UT entry address
IF MD&255='9' THEN MD=MD+'A'-'9' ELSE MD=MD+1
MNEMONIC(DEVTYPE)=MD UNLESS DEVTYPE>15
! ++++++++++++++++++++++++++++++++++++++++++++FF05
IF TABLE(0)+8>TOP TAB ENT START ; *IDLE_X'FF05'; FINISH
TABLE(0)=TABLE(0) + 8; ! 8 WORDS ADDED TO ARRAY FOR THE DEVICE SLOT
TABLE(2)=TABLE(2)+1; ! INCREMENT 'LASTSLOT'
END ; ! NEW ENTRY
ROUTINE REMEMBER(INTEGER INF)
IF NR>=MAX RESPONSEBYTES>>2 START ;
*IDLE_X'FF02'; ! +++++++++++++++++++++++++++++++++++++FF02
FINISH
RESPONSES(NR)=INF
NR=NR+1
END ; ! REMEMBER
ROUTINE INIT RES PIC(INTEGER A,L)
CONSTBYTEINTEGERARRAY BL(0:40)=64(40),21; ! blank line
INTEGER(A)=L
INTEGER(A+4)=-1
MOVE(41,ADDR(BL(0)),A+8)
MOVE(L-41,A+8,A+8+41)
END
!------------------------**GROPE ROUTINE**------------------------------
END
FINISH ELSE START
!
! GPC grope is in three parts
!
!
! part 1 is called for each GPC. it sets TABLE(3) = no of GPCs and table(16+GPCno) = pt.
! it tries to initialise the GPC and, if that fails, returns. it then attempts to connect
! all streams and builds an array of responses. finally it works through the array and builds slots. (note the
! array of responses is easily identified in a hardware dump)
!
!
!part 2 (form tables) is called once only. builds the strmq, pts to slot and pt to gpc. if there are no slots, it
! returns. cycles through slots to build mechslots and assigns values to pts to slot. allocates
! space in communication areas for device entries
!
!
! part 3 (format comms area) is called for each GPC. if no slots, returns. cycles through slots :
! if for this GPC
! formats device entry
! if LP, insert translation table
! if OP, put oper no in slot and allocate
! space in CA for work area
!
! grope builds a communications area for each GPC and a 'TABLE'. the format
! of the table is:
!
!
!
!
! word
! 0 last word currently used
! 1 word which is start of slots
! 2 'LASTSLOT'
! 3 number of GPC's
! 4 word where strmq array starts
! 5 pts to slot
! 6 pt to gpc
! 7 (mag tapes) mechindex
! 8-15 CA addresses for GPC's 0-7
! 16-23 port-trunk for GPC's 0-7
! 24-31 CA sizes (bytes) reqd for GPC's 0-7
! 32-39 starts and limits of oper buffers in comms area
! for oper streams 0-6 (successive oper streams as found
! in GPC table).
! lh halfword = offset from relevant comms area
! rh halfword = no of bytes allocated.
! 40-42 spare
! 43-47 grope vsn (string)
!
! then follow:
! slots
! FLAGS/DEVTYPE/X/LINK
! PROPS0
! PROPS1
! DEV ENT BASE
! C STATUS
! GPTSM
! MNEMONIC
! MECHINDEX/PROPS03/X/STATE
! strmq
! 16 bytes for each GPC. each byte is pointer to a slot
! for a device with a chain in progress (or 'FF')
! pts to slot
! 16 bytes for each pt from lowest to highest, i.e. may be more
! pt's than gpc's. gives rapid translation from pts to (first) slot
! pt to gpc
! 1 byte for each pt from lowest to highest
! translates pt to logical GPC number
! mechindex
! 8 bytes for each MT stream. bytes contain slot numbers. mechindex
! field in slot refers to start of relevant 8 byte array
!
!
! if grope detects a fatal error it idles as follows:
!
!
! FF00 too many GPC's (>8)
! FF01 too many slots (>256) or
! supplied table too small
! FF02 too many entries in 'response' array
! FF03 too many magtape streams (>32)
! (in 'FORM TABLES')
! FF04 too many oper streams (>7)
! (in 'FORM TABLES')
! FF05 supplied table too small
! (in 'CHECKLIM')
!
!
!
!
! for non fatal errors and incidents, a message is placed in the responses array and queued for the oper:
! GPC GROPE nn dd/mm/yy when grope is entered
! PAW=response PT=pt if paw is non zero
! SAW=response PTS=pts if saw is non zero
! RES=response PTS=pts if stream response is non zero
! GPC pt INIT RES=response if a GPC fails to init
! GET CA address if the routine GET CA failed to get control
! GPC GROPE EXIT
!----------------------------------------------------------------------------------------------------
EXTERNALINTEGERFNSPEC GPC INIT(INTEGER CA VA,PT,CHOPSUPE)
EXTERNALROUTINESPEC GET PSTB(INTEGERNAME PSTB0,PSTB1)
EXTERNALROUTINESPEC OPMESS(STRING (63) S)
EXTERNALSTRINGFNSPEC STRHEX(INTEGER N)
SYSTEMROUTINESPEC MOVE(INTEGER S,FROM,TO)
!-----------------------------------------------------------------------
RECORDFORMAT GPCTF(BYTEINTEGER FLAGS,DEVTYPE,SPAREB,LINK, C
INTEGER PROPS0,PROPS1,DEV ENT BASE,SPAREI,GPTSM,MNEMONIC, C
BYTEINTEGER MECHINDEX,PROPS03,SERVRT,STATE)
OWNRECORD (GPCTF)NAME G
RECORDFORMAT RCBF(INTEGER LIMFLAGS,LSTBA,LB BYTES,LBA,AL BYTES, C
ALA,INITWORD,SLOTNO)
OWNRECORD (RCBF)NAME RCB
RECORDFORMAT SEF(INTEGER SAW0,SAW1,RESP0,RESP1)
OWNRECORD (SEF)NAME SENT
RECORDFORMAT CAF(INTEGER MARK,PAW,PIW0,PIW1,CSAW0,CSAW1, C
CRESP0,CRESP1,RECORD (SEF)ARRAY SENTRY(0:15));!LENGTH X120 BYTES
OWNRECORD (CAF)NAME CA
! The following are secondary status byte masks determining what
! abnormal terminations the GPC routine is to print monitor dumps for.
! ZX is a dummy device
CONSTINTEGERARRAY LOGMASK(0:15)= C
0, 0, 0, 0, 0, 0, X'00', 0, 0, 0, 0, 0, 0, 0,X'1FF', 0
! NA PT PR CP CR MT LP GP OP GU DR ZX CT SU FE NA
!
CONSTINTEGERARRAY ADAPTOR BYTES(0:15)= C
0, 0, 0,600,600, 200, 600, 0, 1368, 0, 0, 600, 0, 600, 600, 0
! NA PT PR CP CR MT LP GP OP GU DR ZX CT SU FE NA
! above, the no of bytes for LP adaptors includes the 256 bytes for a
! translate table
! CDM'able devices must have the same adaptor byte size (600).
!
RECORDFORMAT ENTFORM(INTEGER C
SER, GPTSM, PROPADDR, SECS SINCE, CAA, GRCB AD, LBA, ALA, C
STATE, RESP0, RESP1, SENSE1, SENSE2, SENSE3, SENSE4, C
REPSNO, BASE, ID, DLVN, MNEMONIC, C
ENTSIZE, PAW, USAW0, URCB AD, SENSDAT AD, LOGMASK, TRTAB AD, C
UA SIZE, UA AD, TIMEOUT,PROPS0,PROPS1)
OWNRECORD (ENTFORM)NAME D
!
CONSTINTEGER ENT FORM BYTES=128; ! =length of above record format
! This next constant is in words, and includes
! length of ENTFORM =32
! length of GPC's RCB = 8
! length of GPC's LB = 2
! length of GPC's AL = 2
! -----
! total 44
!----------------------------------------------------------------------------------------------------
CONSTINTEGER AL OFFSET = X'48'; ! bytes from RCB A
CONSTINTEGER CONNECT = 0
CONSTINTEGER DEV ENTRY BASIC=44; ! words, size of fixed part of comms area record format
CONSTINTEGER DO CONTROLLER REQUEST = X'04000000'
CONSTINTEGER DO STREAM REQUEST = X'01000000'
CONSTINTEGER FE = 14
CONSTINTEGER GPC DEST = X'40000800'
CONSTINTEGER INITIALISE = 4
CONSTINTEGER INIT CONTROLLER = X'32000010'
CONSTINTEGER LB OFFSET = X'20'; ! bytes from RCB A
CONSTINTEGER LOADREP = 3
CONSTINTEGER LOGICAL STREAM = X'F00F0'
CONSTINTEGER LP = 6
CONSTINTEGER LP REP OFFSET = X'280'
CONSTINTEGER LST RA = X'8080'
CONSTINTEGER MAX GPC NO = 7
CONSTINTEGER MAX RESPONSE WORDS = X'3E0'
CONSTINTEGER MT = 5
CONSTINTEGER MT6PROP = X'100'
CONSTINTEGER ONE RCB OFFSET = X'120'
CONSTINTEGER OP = 8
CONSTINTEGER PROP DAT OFFSET = X'90'; ! =144 bytes from RCB A
CONSTINTEGER SENDPROP = 1
CONSTINTEGER SENS DAT OFFSET = X'98'; ! =152 bytes from RCB A
CONSTINTEGER SLOTSI = 32; ! slot size
CONSTINTEGER SU=13; ! Switch unit
CONSTINTEGER TOPLSEG = 5
CONSTINTEGER WRITECONTROL = 5
CONSTINTEGER ZX=11; ! dummy device
!----------------------------------------------------------------------------------------------------
EXTRINSICINTEGER FEP MAP
OWNINTEGER CAA
OWNINTEGER COUNT
OWNINTEGER DEVTYPE
OWNINTEGER GPC COUNT; ! used for part 3
OWNINTEGER GPCNO
OWNINTEGER GPCT BASE
OWNINTEGER GPTSM
OWNINTEGER J
OWNINTEGER LASTSLOT
OWNINTEGER MAGSLOTS
OWNINTEGER NO OF RESPONSES
OWNINTEGER OPSLOTS
OWNINTEGER PAWSAWFAILS
OWNINTEGER PROPDATADDR
OWNINTEGER PROPS
OWNINTEGER PROPS1
OWNINTEGER PT
OWNINTEGER RCBA
OWNINTEGER RESP0
OWNINTEGER RESP1
OWNINTEGER SENSDATADDR
OWNINTEGER SETUP
OWNINTEGER STRM
OWNINTEGER TOP TABLE ENTRY
OWNINTEGER TRUNKADDR
OWNINTEGER SPARE SLOT
OWNINTEGERARRAYNAME RESPONSES
OWNINTEGERARRAYNAME TABLE
!
CONSTHALFINTEGERARRAY TIMEOUT SECONDS(0:15)= C
10, 60, 60,600,300, 30, 60, 10, 10, 10, 10, 10, 10, 10, 3, 10
! NA PT PR CP CR MT LP GP OP GU DR ZX CT SU FE NA
!
CONSTINTEGERARRAY GPCS LOGIC BLOCK(0:1)= C
X'04F10800', X'00F00400'
! CONNECT SENSE
! COMMD CHAIN
!
OWNBYTEINTEGERARRAYFORMAT BIFT(0:511)
OWNINTEGERARRAYFORMAT IFT(0:1023)
OWNINTEGERARRAY LBE(0:5)= C
X'04F10800',X'04F00E00',X'00F00402',X'80F02504',X'80F00106',X'82F00500'
! CONNECT PROP CODES SENSE LOAD REP INITIALISE WRITECONTROL
! COMMDCHAIN COMMDCHAIN OUTWARDS OUTWARDS OUTWARDS,LITERAL(ZERO)
!
!
!
EXTRINSICINTEGER LP ILLCHAR; ! SET UP IN GPC - ERCC VALUE=X'07'
! UKC MAY USE BACK '?'
!
!----------------------------------------------------------------------------------------------------
!
ROUTINE CHECKLIM(INTEGER WORDS REQ)
IF TABLE(0) + WORDS REQ > TOP TABLE ENTRY START
*IDLE_X'FF05'; !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++FF05
FINISH
TABLE(0) = TABLE(0) + WORDS REQ
END ; ! OF CHECK LIM
!
ROUTINE SEND CHFLAG(INTEGER PT)
TRUNKADDR=GPC DEST ! (PT<<16)
*LB_TRUNKADDR
*LSS_1
*ST_(0+B )
END ; ! SEND CHFLAG
!
ROUTINE MSG(STRING (31)TXT)
INTEGER A, I
A = ADDR(RESPONSES(NO OF RESPONSES))
FOR I=0,1,LENGTH(TXT) CYCLE
BYTEINTEGER(A+I) = BYTEINTEGER(ADDR(TXT)+I)
REPEAT
BYTEINTEGER(A) = X'80'; ! to 'invalidate' the entry
NO OF RESPONSES = NO OF RESPONSES + 8
OPMESS(TXT)
END ; ! OF MSG
!
INTEGERFN GET CA(INTEGER CAA)
RECORD (CAF)NAME CA
INTEGERNAME MARK
CA == RECORD(CAA)
MARK == CA_MARK
COUNT = 0
LOOP:
COUNT = COUNT + 1
IF COUNT > 100000 THEN -> ERROR
*INCT_(MARK)
*JCC_8,<OUT>; ! =-1
*JCC_5,<LOOP>; ! >-1
! drop through if <-1
ERROR:
MARK = 0; ! force free
MSG("Get CA ".HTOS(CAA,8))
RESULT = 1
OUT:
RESULT = 0
END ; ! GET CA
!
ROUTINE REMEMBER(INTEGER INF)
IF NO OF RESPONSES>=MAX RESPONSEWORDS START ;
*IDLE_X'FF02'; ! +++++++++++++++++++++++++++++++++++++++++++++++++FF02
FINISH
RESPONSES(NO OF RESPONSES)=INF
NO OF RESPONSES=NO OF RESPONSES+1
END ; ! REMEMBER
!
ROUTINE INVALIDATE(INTEGER ENT)
RESPONSES(ENT)=RESPONSES(ENT) ! X'80000000'
END ; ! INVALIDATE
!
ROUTINE DO(INTEGER COMMAND)
INTEGER J, CURNR
DEVTYPE = 0; ! so that if get CA fails, grope(1) doesnt run amok
RCB_LBA=ADDR(LBE(COMMAND))
IF GET CA(CAA) > 0 THEN -> OUT
IF CA_PAW#0 START
MSG("PAW=".HTOS(CA_PAW,8)." pt=".HTOS(PT,2))
PAWSAWFAILS=PAWSAWFAILS+1
FINISH
CA_PAW=DOSTREAM REQUEST ! STRM
CA_CRESP0=0
IF SENT_SAW0#0 START
MSG("SAW=".HTOS(SENT_SAW0,8)." pts=".HTOS((PT<<4)!STRM,3))
PAWSAWFAILS=PAWSAWFAILS+1
FINISH
IF SENT_RESP0#0 START
MSG("RES=".HTOS(SENT_RESP0,8)." pts=".HTOS((PT<<4)!STRM,3))
FINISH
SENT=0
SENT_SAW0=X'30000020'; ! SAW flags + RCB bound
SENT_SAW1=RCBA
CA_MARK=-1
SEND CHFLAG(PT);
WAIT:
COUNT=0
COUNT=COUNT+1 UNTIL SENT_RESP0#0 OR COUNT>100000
IF GET CA(CAA) > 0 THEN -> OUT
CA_PIW0=CA_PIW0 & (¬(X'80000000'>>STRM))
RESP0=SENT_RESP0
RESP1=SENT_RESP1
SENT_RESP0=0
CA_MARK=-1
! remember 8 words
IF INTEGER(PROPDATADDR)=0 AND SPARE SLOT=0 START ; !set up spare slot
SPARE SLOT=1
INTEGER(PROPDATADDR)=ZX<<24
RESP0=X'1000'
FINISH
CUR NR = NO OF RESPONSES
REMEMBER((GPCNO<<16)!(PT<<8)!(STRM<<4))
REMEMBER(RESP0)
REMEMBER(RESP1)
PROPS=INTEGER(PROPDATADDR)
REMEMBER(PROPS)
INTEGER(PROPDATADDR) = 0
PROPS1=INTEGER(PROPDATADDR+4)
REMEMBER(PROPS1)
INTEGER(PROPDATADDR+4)=0
FOR J=0,4,8 CYCLE
REMEMBER(INTEGER(SENSDATADDR + J))
INTEGER(SENSDATADDR + J)=0
REPEAT
DEVTYPE=PROPS>>24
! check that response is useful else 'invalidate'
IF (RESP0 >> 20) & 15 = 1 START ;! not interested in attns
INVALIDATE(CUR NR)
-> WAIT
FINISH
IF DEVTYPE = 0 THEN -> INVAL
! CHECK FOR 7905 (IN WHICH WE ARE NOT INTERESTED)
! IT RETURNS RESP0 = 00408001
IF RESP0 & X'1000' = 0 THEN -> INVAL
-> OUT
INVAL:
INVALIDATE(CUR NR)
OUT:
END ; ! DO
!
ROUTINE NEW SLOT(INTEGER DEVTYPE,GPTSM,PROPS0,PROPS1,AUTO)
OWNINTEGERARRAY MNEMONIC(1:15)= C
M'PT0', M'PR0', M'CP0', M'CR0', M'M00',
M'LP0', M'GP0', M'OP0', M'GU0', M'DR0',
M'ZX0', M'CT0', M'SU0', M'FE0', M'LK0'
INTEGER MD
G == RECORD(ADDR(TABLE(TABLE(0) + 1)))
CHECKLIM(8)
G_DEVTYPE=DEVTYPE
G_GPTSM=GPTSM
IF DEVTYPE=OP THEN G_MECHINDEX<-PROPS0
! mnemonic for a MT is bottom 7 bits of
! byte 1 of props as 2 iso chars
IF DEVTYPE = MT START
MD = M'M00' + PROPS0 << 9 >> 29 << 8 + PROPS0 << 12 >> 28
FINISH ELSE START
IF DEVTYPE = FE START
MD=PROPS0<<8>>24
FEP MAP=FEP MAP!1<<MD
MD=MD+M'FE0'
FINISH ELSE IF DEVTYPE=SU START
MD=MNEMONIC(DEVTYPE)!PROPS0<<8>>24
FINISH ELSE START
MD = MNEMONIC(DEVTYPE)
IF MD & 255 = '9' C
THEN J = MD - '9' + 'A' C
ELSE J = MD + 1
MNEMONIC(DEVTYPE) = J
FINISH
FINISH
G_MNEMONIC=MD
G_PROPS0 = PROPS0
G_PROPS1 = PROPS1
G_PROPS03<-AUTO; ! this is byte 3 of props, except for LP, when
! it's 1st tertiary status byte (containing auto bit)
TABLE(2)=TABLE(2)+1; ! increment 'lastslot'
END ; ! NEW SLOT
!
INTEGERFN GPC REINIT(INTEGER OLD CA,NEW CA,PT)
!
! RESULT=0 OK
! 2<<24 ! CRESP0 initialise failed
!
RECORDFORMAT INIF(INTEGER PST S,PST A,CAA,SOE)
RECORD (INIF) INI
RECORDFORMAT CA0F(INTEGER MARK,PAW,PIW0,PIW1,CSAW0,CSAW1, C
CRESP0,CRESP1); ! length X20 bytes
RECORD (CA0F)NAME CA0
RECORD (CA0F)NAME CA
!
CA0==RECORD(OLD CA)
! clear and obtain control of comms area
CA0=0
CA0_PAW=DO CONTROLLER REQUEST
CA0_CSAW0=INIT CONTROLLER
CA0_CSAW1=ADDR(INI)
GET PSTB(INI_PST S,INI_PST A)
INI_CAA=NEW CA
INI_SOE=0
! initialise the new comms area
CA==RECORD(NEW CA)
CA=0
CA_MARK=-1
CA0_MARK=-1; ! free coms area, and let controller do the job
SEND CH FLAG(PT)
COUNT=0
COUNT=COUNT+1 UNTIL CA_CRESP0#0 OR COUNT>200000
IF GET CA(NEW CA) > 0 THEN RESULT = 2<<24
IF CA_CRESP0<<8 >=0 START
RESULT =(2<<24) ! CA_CRESP0; ! initialise failed
FINISH
CA_CRESP0=0
CA_MARK=-1
RESULT =0; ! success
END ; ! GPC REINIT
!
ROUTINE FORM TABLES
INTEGER NGPCS,J,N,LOPTS,HIPTS,TAD,TEND,SLOTNO
INTEGER PTS,GPCNO
INTEGER LASTSTREAM, THIS STREAM, MECH BASE
BYTEINTEGERARRAYNAME PTS TO SLOT
BYTEINTEGERARRAYNAME PT TO GPC
BYTEINTEGERARRAYNAME MECHSLOTS
NGPCS=TABLE(3)
! strm semaphores 16 words/GPC
N = TABLE(0)
TABLE(40) = N + 1
FOR J=1,1,NGPCS<<4 CYCLE
CHECKLIM(1)
TABLE(N+J) = -1
REPEAT
! strmq - need 4 words per GPC
N=TABLE(0)
TABLE(4)=N+1; ! start entry in table of strmq array
FOR J=1,1,NGPCS<<2 CYCLE
CHECKLIM(1)
TABLE(N+J)=X'FFFFFFFF'
REPEAT
! pts to slot
N=TABLE(0)+1
LOPTS=TABLE(16)<<4; ! eg. X'150' for port 1 trunk 5
HIPTS=(TABLE(16+ NGPCS-1)<<4) + 15; ! eg. X'16F' if top port/trunk is 16
TAD=ADDR(TABLE(N)); ! address of start of pts to slot array
TABLE(5)=N; ! start entry in table of ditto
TEND=TAD + HIPTS - LOPTS; ! address of last byte of pts array
J = (HIPTS - LOPTS + 1) >> 2
CHECKLIM(J)
FOR J=TAD,1,TEND CYCLE
BYTEINTEGER(J)=255; ! set=unused
REPEAT
PTS TO SLOT==ARRAY(TAD,BIFT)
! pt to GPC
N=TABLE(0)+1
TABLE(6)=N
PT TO GPC==ARRAY(ADDR(TABLE(N)),BIFT)
! one byte per pt, rounded to n words
J=(HIPTS-LOPTS+X'31')>>6
CHECKLIM(J)
FOR J=0,1,NGPCS-1 CYCLE
PT TO GPC(TABLE(16+J)-LOPTS>>4)=J
! holes in this array will be left unassigned
REPEAT
TABLE(7) = TABLE(0) + 1; ! start of mechslots array
IF LAST SLOT < 0 THEN RETURN
MECHBASE = -8
LAST STREAM = LOGICAL STREAM
FOR SLOTNO=0,1,LASTSLOT CYCLE
G==RECORD(GPCT BASE + SLOTNO*SLOTSI)
GPC NO = (G_GPTSM >> 16) & 15
IF G_DEVTYPE=MT START
THIS STREAM = G_GPTSM & LOGICAL STREAM
UNLESS THIS STREAM = LAST STREAM START
! a new stream
J = TABLE(0) + 1
CHECKLIM(2); ! 2 words
TABLE(J) = X'FFFFFFFF'; ! initialise
TABLE(J+1) = X'FFFFFFFF'
MECHSLOTS == ARRAY(ADDR(TABLE(J)), BIFT)
LAST STREAM = THIS STREAM
MECH BASE = MECH BASE + 8
FINISH
MECHSLOTS(G_GPTSM & 15) = SLOTNO
G_MECHINDEX = MECHBASE
MAGSLOTS = MAGSLOTS + 1
FINISH
PTS = (G_GPTSM >> 4) & X'FFF'
IF PTS TO SLOT(PTS - LOPTS) = 255 START
PTS TO SLOT(PTS - LOPTS) <- SLOTNO UNLESS G_DEVTYPE=ZX; !except spare slot
FINISH
! allocate space for each device plus
! work areas for device adaptors
TABLE(24 + GPC NO) = (TABLE(24+GPC NO)+7) & (¬7) + C
DEV ENTRY BASIC << 2 + C
ADAPTOR BYTES(G_DEVTYPE)
REPEAT
! allocate space for operlog
! in first comms area
J = TABLE(24)
J = (J+3) & (-4); ! round up to a word boundary
TABLE(41) = J; ! operlog
TABLE(24) = J + 1976; ! = 8 + 48*41
END ; ! FORM TABLES
!
ROUTINE INIT RES PIC(INTEGER A, L)
CONSTBYTEINTEGERARRAY BL(0:40) = 64(40), 21; ! a blank line
INTEGER(A) = L
INTEGER(A+4) = -1
MOVE(41,ADDR(BL(0)),A+8)
MOVE(L-41,A+8,A+8+41)
END ; ! OF INIT RES PIC
!
! called by part 3 of grope once for each GPC
! number of current GPC is in global variable GPC count
ROUTINE FORMAT COMMS AREA(INTEGER CAA)
INTEGER J,SLOTNO, DEV OFFSET,CART,DEV ENT BASE
INTEGER REPAD,REPLEN,IX,CH,GNO
BYTEINTEGERARRAYNAME REP,TRTAB
RECORDFORMAT GPCS RCB LB ALF(RECORD (RCBF) RCB, C
INTEGER LBE0, LBE1, ALE0 BYTES, ALE0 ADDR, ALE1 BYTES, ALE1 ADDR)
RECORD (GPCS RCB LB ALF)NAME GPCS RCB
IF LAST SLOT < 0 THEN RETURN
DEV OFFSET=X'120'
FOR SLOTNO=0,1,LASTSLOT CYCLE
G==RECORD(GPCT BASE + SLOTNO*SLOTSI)
GNO=(G_GPTSM>>16) & 15
IF GNO=GPC COUNT START
! if the slot relates to this GPC (ie. this comms area) then
! format the device entry.
DEVTYPE=G_DEVTYPE
DEV ENT BASE=CAA + DEV OFFSET
D==RECORD(DEV ENT BASE)
G_DEV ENT BASE=DEV ENT BASE
D_GPTSM=G_GPTSM
D_PROPS0=G_PROPS0
D_PROPS1=G_PROPS1
D_PROPADDR=ADDR(D_PROPS0)
D_CAA=CAA
D_GRCB AD=DEV ENT BASE + ENT FORM BYTES
D_MNEMONIC=G_MNEMONIC
D_LOGMASK=LOGMASK(DEVTYPE)
D_SENSDAT AD=ADDR(D_SENSE1)
D_TIMEOUT=TIMEOUT SECONDS(DEVTYPE)
GPCS RCB==RECORD(D_GRCB AD)
GPCS RCB=0
GPCS RCB_RCB_LIMFLAGS=X'4000'; ! trusted chain
GPCS RCB_RCB_LB BYTES=8
GPCS RCB_RCB_LBA=ADDR(GPCS RCB_LBE0)
GPCS RCB_RCB_AL BYTES=8
GPCS RCB_RCB_ALA=ADDR(GPCS RCB_ALE0 BYTES)
GPCS RCB_LBE0=GPCS LOGIC BLOCK(0)
GPCS RCB_LBE1=GPCS LOGIC BLOCK(1)
GPCS RCB_ALE0 BYTES=16
GPCS RCB_ALE0 ADDR=ADDR(D_SENSE1)
D_UA AD=DEV ENT BASE + DEV ENTRY BASIC<<2
D_UA SIZE=ADAPTOR BYTES(DEVTYPE)
D_ENT SIZE=DEV ENTRY BASIC<<2 + D_UA SIZE
IF DEVTYPE=LP START
CART=(G_PROPS1>>16)&15
D_UA SIZE=D_UA SIZE - 256; ! take off size of translate table
D_TRTAB AD=D_UA AD + D_UA SIZE
! create the translate table, based on the repertoire
REPAD=REPERTOIRE ADDR(CART)
REP==ARRAY(REPAD,BIFT)
REPLEN=REPERTOIRE LEN(CART)
TRTAB==ARRAY(D_TRTAB AD,BIFT)
IF CART=0 START
FOR IX=0,1,255 CYCLE ; TRTAB(IX)=IX; REPEAT
FINISH ELSE START
FOR IX=0,1,255 CYCLE
CH=LP ILLCHAR; ! del (07) for ERCC, UKC may use back '?'
J=0
WHILE J<REPLEN CYCLE
IF IX=REP(J) THEN CH=IX AND EXIT
J=J+1
REPEAT
! insert 'format effectors' at own values
! and also turn lf (x'25') into newline (x'15')
IF IX=X'15' THEN CH=X'15'
IF IX=X'25' THEN CH=X'15'
IF IX=X'0C' THEN CH=X'0C'; ! NEWLINE
IF IX=X'0D' THEN CH=X'0D'
IF IX=X'40' THEN CH=X'40'; ! SPACE
! If value IX was not found in repertoire (CH still LP ILLCHAR),
! was it a lower case letter? If so, change it to upper case.
! (We do not search to see if the upper case letter is in the
! repertoire (surely it is)).
IF CH=LP ILLCHAR AND C
(X'81'<=IX<=X'89' OR X'91'<=IX<=X'99' OR C
X'A2'<=IX<=X'A9') THEN CH=IX ! X'40'
TRTAB(IX)=CH
REPEAT
FINISH ; ! cartridge setting non-zero
FINISH ; ! LP DEVICE
IF DEVTYPE = OP START
UNLESS OPSLOTS < 7 START
*IDLE_X'FF04'; !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++FF04
FINISH
G_MECHINDEX = G_MECHINDEX ! (OPSLOTS << 4)
TABLE(32 + OPSLOTS) = C
D_UA AD << 16 + D_UA SIZE
OPSLOTS = OPSLOTS + 1
FINISH
DEV OFFSET=DEV OFFSET + D_ENT SIZE
FINISH ; ! slot belongs to this GPC
REPEAT
END ; ! FORMAT COMMS AREA
!
EXTERNALROUTINE GPC GROPE(RECORD (PARMF)NAME P)
INTEGER LPINITWORD,CART
INTEGER MPROP,AUTO,NEW CAA,FORM STYLE,FORM LEN
INTEGER I,J,K,L
INTEGER A,S
INTEGER DACT
INTEGER CURNR
!
RECORDFORMAT ALEF(INTEGER BYTES,ADDR)
RECORD (ALEF)ARRAYFORMAT ALEFF(0:3)
RECORD (ALEF)ARRAYNAME ALE
RECORDFORMAT RF(INTEGER GPTSM,RESP0,RESP1,PROPS0,PROPS1, C
SENS0,SENS1,SENS2)
RECORD (RF)NAME R
!
SWITCH GROPE(1:3)
DACT=P_DEST&X'FFFF'
UNLESS 0<DACT<=3 THEN RETURN
-> GROPE(DACT)
! initialise GPC and grope
! called for each GPC, pt in ascending order
! on first call, various initialisations done
! P1 = pt
! P2 = addr of table
! P3 = CAA
! P4 = size of table
GROPE(1):
IF SETUP = 0 START
SETUP = 1
RESPONSES == ARRAY(X'81002080', IFT)
FOR J=0,1,MAX RESPONSE WORDS-1 CYCLE
RESPONSES(J) = X'88888888'
REPEAT
FOR J=0,1,15 CYCLE
REPERTOIRE ADDR(J) = ADDR(LP96REP(0))
REPERTOIRE LEN(J) = 96
REPEAT
REPERTOIRE ADDR(3) = ADDR(LP384REP(0))
REPERTOIRE LEN(2) = 48
REPERTOIRE LEN(3) = 384
REPERTOIRE LEN(4) = 64
TABLE == ARRAY(P_P2, IFT)
TOP TABLE ENTRY = P_P4
TABLE(0) = 47; ! last word 'used'
TABLE(1) = 48; ! start of slots
TABLE(2) = -1; ! last slot
TABLE(3) = 0; ! no of GPCS
GPCT BASE = ADDR(TABLE(TABLE(1)))
STRING(ADDR(TABLE(44))-1)=VSN
MSG(VSN)
FINISH
PT = P_P1
CAA = P_P3
GPC NO = TABLE(3)
IF GPC NO > MAX GPC NO START
*IDLE_X'FF00'; !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++FF00
FINISH
TABLE(3) = GPC NO + 1
TABLE(16 + GPC NO) = PT
TABLE(24 + GPC NO) = X'120'
J = GPC INIT(CAA, PT, 1)
UNLESS J = 0 START
MSG("GPC ".HTOS(PT,2)." init res=".HTOS(J,8))
RETURN
FINISH
RCBA=CAA + ONE RCB OFFSET
RCB==RECORD(RCBA)
CA==RECORD(CAA)
RCB_LIMFLAGS = X'4000' ! (TOPLSEG << 18); ! trusted
RCB_LSTBA=LST RA
RCB_LB BYTES=AL OFFSET - LB OFFSET
RCB_LBA=RCBA + LB OFFSET
RCB_AL BYTES=PROPDAT OFFSET - AL OFFSET
RCB_ALA=RCBA+AL OFFSET
PROPDATADDR=RCBA + PROPDAT OFFSET
SENSDATADDR=RCBA + SENSDAT OFFSET
ALE==ARRAY(RCBA + AL OFFSET,ALEFF)
! properties data
ALE(0)_BYTES=8
ALE(0)_ADDR=PROPDATADDR
! sense data
ALE(1)_BYTES=12
ALE(1)_ADDR=SENSDATADDR
! load rep data
ALE(2)_BYTES=384
ALE(2)_ADDR=CAA + LPREP OFFSET
! LP init data
ALE(3)_BYTES=4
ALE(3)_ADDR=ADDR(LPINITWORD)
STRM=0
PAWSAWFAILS=0
SPARE SLOT=0; ! set up spare slot (if possible)
UNTIL STRM>=15 OR PAWSAWFAILS>=2 CYCLE
SENT == CA_S ENTRY(STRM)
CURNR=NO OF RESPONSES
J=CURNR; ! save for possible connect repeat
! 'DO' computes DEVTYPE, PROPS & PROPS1
DO(CONNECT)
! if 'DO' fails, DEVTYPE is set to zero
IF DEVTYPE=0 START ; ! 1st connect always fails for EMLAN fep !!
CURNR=J
NO OF RESPONSES=J
WAIT(10); ! (also needs a wait)
DO(CONNECT); ! so try again
FINISH
IF DEVTYPE = MT START
INVALIDATE(CURNR)
DO(SENDPROP)
FINISH ELSE START
IF DEVTYPE = LP START
! PROPS has bytes 0-3 of LP properties
! PROPS1 has bytes 4-5
! bottom 4 bits of byte 5 has cartridge number set on front of LP.
! if cartridge number is set zero, we don't load any rep if
! there's one already loaded, else we load the 64-char rep
! (being the first 64 chars of the 96-char rep above).
! if the cartridge number is :
! 2 we load the 48-char rep for the BT DPE CRAIGLOCKHART 2970
! 3 we load the 384-char rep for the BUSH ESTATE 2980
! 4 we load the 64-char rep for the BT DPE BARBICAN 2970
! 5 we load the 96-char rep for the ERCC-KB 2972s
FORM STYLE=PROPS&255
FORM LEN=(FORM STYLE>>4)*10 + FORM STYLE&15
FORM LEN=66 IF FORM LEN=0
LBE(WRITECONTROL)= C
(LBE(WRITECONTROL)&(¬255))!(FORM LEN - 1)
CART=(PROPS1>>16)&15
A = REPERTOIRE ADDR(CART)
S = REPERTOIRE LEN(CART)
I=0
WHILE I<384 CYCLE ; ! repertoire buffer must be filled with 384 bytes
J=A; ! to start of relevant array
WHILE J<A+S CYCLE
INTEGER(CAA+LPREP OFFSET+I)=INTEGER(J)
I=I+4; J=J+4
REPEAT
REPEAT
! what we are doing here is - we want the props & sense info in one entry. the first
! chain (sendprop) fails short block until LP has had
! initialise. so when we've done that we invalidate the first
! entry and do another sendprop+sense, and "NEW ENTRY" uses
! that one. this way we can pick up the auto bit in tertiary status to
! pass to GPC (we want to allocate M'LP' to be the first LP in auto if
! more than one available).
INVALIDATE(CURNR)
LPINITWORD=X'00000010'; ! back-question for illegal, auto-throw not set
DO(INITIALISE)
UNLESS CART = 0 AND C
(PROPS1 & X'100000') = 0 C
THEN DO(LOADREP)
LPINITWORD=X'0000FC10'
DO(INITIALISE)
DO(WRITECONTROL) UNLESS FORM STYLE=X'99'; ! value for testing omitting write control
DO(SENDPROP)
FINISH ELSE START
IF DEVTYPE > 15 THEN INVALIDATE(CURNR)
FINISH
FINISH
STRM=STRM+1
REPEAT
! build slots for this GPC
FOR J=0,8,NO OF RESPONSES-8 CYCLE
R==RECORD(ADDR(RESPONSES(J)))
GPTSM=R_GPTSM
IF GPTSM>>30 = 0 START
MPROP=R_PROPS0
DEVTYPE=MPROP>>24
! for LP, pass first byte of tertiary status to go into mechindex field
! (there is one secondary followed by 7? tertiary status bytes).
! in GPC table (contains manual/auto bit)
IF DEVTYPE = MT START
MPROP = MPROP & X'FFF0FFFF'
FINISH
AUTO=MPROP
IF DEVTYPE=LP THEN AUTO=R_SENS0>>16
NEW SLOT(DEVTYPE,GPTSM,MPROP,R_PROPS1,AUTO)
! for mag tape streams, add slots up to 4 (for MT4) or 8 (for MT6), with
! increasing mechanism numbers (start at 0).
IF DEVTYPE=MT START
K=3; ! 3 more for MT4
IF R_PROPS0 & MT6PROP#0 THEN K=7; ! 7 more for MT6
FOR L=1,1,K CYCLE
GPTSM=GPTSM+1; ! add one into mech field
MPROP=MPROP + X'00010000'; ! & 1 into handler no.
NEW SLOT(DEVTYPE,GPTSM,MPROP,R_PROPS1,MPROP)
REPEAT
FINISH
! invalidate so not picked up when grope called again
R_GPTSM=GPTSM ! X'40000000'
FINISH
REPEAT
P_P1=0
RETURN
!
! part 2 all GPCs have now been groped, form tables
!
GROPE(3):
LAST SLOT = TABLE(2)
FORM TABLES
! at this point, TABLE(24+n) must have been set
! up so that sup can supply suitably sized segments
RETURN
! part 3 re-initialise the GPCs to use virtual addrs
! and format the communications areas
!
GROPE(2):
! P_P1 is port+trunk
! P_P2 is table address
! P_P3 is virtual address of old CA segment
! P_P4 is virtual address of new CA segment
IF LASTSLOT<0 THEN RETURN
NEW CAA=P_P4
TABLE(GPC COUNT + 8)=NEW CAA
IF GPC COUNT = 0 START
! earliest possible time to init res pics
TABLE(41) = TABLE(41) + NEW CAA
INIT RES PIC(TABLE(41), 48*41)
FINISH
P_P1=GPC REINIT(P_P3,NEW CAA,P_P1)
FORMAT COMMS AREA(NEW CAA)
GPC COUNT=GPC COUNT + 1
RETURN
END ; ! GPC GROPE
EXTERNALROUTINE DISCGROPE(RECORD (PARMF)NAME P)
!***********************************************************************
!* TRIES TO READ PROPERTY CODES OF ALL 15 STREAMS ON A FPC2 *
!***********************************************************************
INTEGERFNSPEC PROPCODES(INTEGER STRM)
RECORDFORMAT CCAFORM(INTEGER MARK,PAW,PIW1,PIW2,CSAW1,CSAW2,C
CRESP1,CRESP2,LONGLONGREALARRAY STRMS(0:15))
RECORDFORMAT RQBFORM(INTEGER LSEGPROP, LSEGADDR, LBPROP, LBADDR, C
ALPROP, ALADDR, W6, W7, W8)
RECORDFORMAT DDTFORM(INTEGER SER, PTS, PROPADDR, STICK, CCA, RQA, C
LBA, ALA, STATE, IW1, CONCOUNT, SENSE1, SENSE2, SENSE3, C
SENSE4, REPSNO, BASE, ID, DLVN, MNEMONIC, C
STRING (6) LAB, BYTEINTEGER MECH, C
INTEGER PROPS,STATS1,STATS2, C
BYTEINTEGER QSTATE,PRIO,SP1,SP2, C
INTEGER LQLINK,UQLINK,CURCYL,SEMA,TRLINK,CHFISA)
RECORDFORMAT PROPFORM(INTEGER TRACKS,CYLS,PPERTRK,BLKSIZE,TOTPAGES,C
RQBLKSIZE,LBLKSIZE,ALISTSIZE,KEYLEN,SECTINDX)
RECORDFORMAT INITFORM(INTEGER W0, W1, W2, W3, W4)
RECORD (INITFORM) INIT
EXTERNALINTEGERSPEC HI STRM
CONSTINTEGER DDTSIZE=128
CONSTINTEGER TEMP CA=X'80000000'!10<<18
CONSTINTEGER TIMEOUT=200000
CONSTINTEGER SD=X'58000000', LST RA=X'8080'
CONSTINTEGER READ9388=X'93880E80'; ! TO READ DFC WORD FOR EXTENDED OPTION FLAG
CONSTINTEGER EXFLAG=X'08000000'; ! FLAG
CONSTINTEGER AFA=X'100',RFB=X'400'
RECORD (PROPFORM)NAME PROP
RECORD (CCAFORM)NAME ICA,CCA
RECORD (RQBFORM)NAME RQB
RECORD (DDTFORM)NAME DDT
INTEGER PT, ISA, STRM, AD, I,J,K, M, DITADDR, PTR, SIZE, C
NCONTROLERS, INF, RESPONSE, FAILCOUNT, MNEM
FAILCOUNT=0
IF P_DEST#0 THEN ->REINIT
PT=P_P1; ! PORT & TRUNK IN P_P1
ISA=X'40000800'!PT<<16
! FIND OUT HOW MANY STREAMS
*LB_ISA; *LSS_3; *ST_(0+B ); ! 2 SUSPENDS BEFORE DCM
WAIT(1)
*LB_ISA; *LSS_(0+B ); ! READ TO CLEAR P4 LOCK
*LSS_3; *ST_(0+B ); *LSS_(0+B )
*ADB_X'500'; ! TO X'40PT0D00'
*LSS_X'400'; *ST_(0+B ); ! SET DCM
*ADB_X'100'; ! TO X'40PT0E00'
*STB_I
*LSS_READ9388; ! REQUIRED WORD
*ST_(0+B ); ! READ IT
K=200
AWAIT: ! WAIT FOR RESPONSE
*LB_I
*LSS_(0+B )
*ST_J
K=K-1
->AWAIT UNLESS K=0 OR J&RFB#0
*LSS_AFA; ! SEND RESPONSE
*LB_I
*ST_(0+B )
*LSS_X'1E12'; *ST_(0+B ); ! MASTER CLEAR & FBS
*SBB_X'100'; ! TO X'40PT0D00'
*LSS_0; *ST_(0+B ); ! UNSET DCM & MC
HI STRM=15
UNLESS K=0 START
IF J&EXFLAG#0 THEN HI STRM=7; ! 8 STREAMS
PRINTSTRING("DFC ".HTOS(PT,2)." EXOPT reg = ".HTOS(J,8)."
")
FINISH ELSE OPMESS("DFC ".HTOS(PT,2)." EXOPT flag RTO")
WAIT(100); ! SETTLE DOWN
GROPE AGAIN: ! AFTER SHIFT CA FROM 0 FAILS
CCA==RECORD(0)
CCA_MARK=-1
INIT=0
INIT_W0=((INTEGER(PST VA+PST SEG*8)&X'FFFC'+X'80')//8-1)<<18!X'80000000'
INIT_W1=INTEGER(PST VA+PST SEG*8+4)&X'0FFFFF80'
INIT_W2=TEMP CA
CCA_PAW=X'04000000'; ! CONTROLLER REQUEST
CCA_CSAW1=X'32000014'; ! ** STRAW CLUTCH **JM**!!
! CCA_CSAW1=X'12000014'
CCA_CSAW2=REALISE(ADDR(INIT))
! RESPONSE WILL BE NEW COMM AREA. REMAP CCA BEFORE FIRING IO
CCA==RECORD(TEMP CA)
CCA=0; CCA_MARK=-1
*LB_ISA; *LSS_1; *ST_(0+B )
J=0
WHILE CCA_CRESP1=0 OR CCA_MARK#-1 CYCLE
J=J+1
IF J>TIMEOUT THEN START
OPMESS("DISCGROPE failed".HTOS(PT,2))
DUMPTABLE(10,REAL0ADDR,32)
DUMPTABLE(11,ADDR(CCA),32)
IF FAILCOUNT<4 START
*LB_ISA; *LSS_2; *ST_(0+B )
FAILCOUNT=FAILCOUNT+1
WAIT(100*FAILCOUNT)
->GROPE AGAIN; ! HAVE ANOTHER SHOT
FINISH
RETURN
FINISH
REPEAT
RQB==RECORD(X'120'+TEMP CA)
RQB_LSEGPROP=128<<18!X'C000'
RQB_LSEGADDR=LST RA
RQB_LBPROP=X'18000008'
RQB_LBADDR=X'200'+TEMP CA
RQB_ALPROP=X'18000010'
RQB_ALADDR=X'210'+TEMP CA
RQB_W6=X'FF00'; ! STATUS MASK
RQB_W7=X'02001300'
! SET UP ONE LOGICAL BLOCK ENTRY AND ONE ADDRESSLIST ENTRY TO READ
! PROPERTY CODES. ALL STREAMS WILL USE SAME RQB ETC
! CYCLE THRU ALL POSSIBLE STREAMS
CYCLE STRM=0,1,HI STRM
RESPONSE=PROPCODES(STRM)
!
! FIRST STREAM GIVES ERRONEOUS RESPONSE DUE TO UNKNOWN TIMING
! IF THERE IS NO STREAM 0 THEN WAIT A BIT AND TRY AGAIN
!
IF RESPONSE=X'00411001' AND STRM=0 THEN C
WAIT(500) AND RESPONSE=PROPCODES(0)
! BUILD THE DISC DEVICE TABLE FROM PROPERTY CODES
M=J>>16&255
K=J>>24
MNEM=M'ED'
UNLESS K=X'33' OR K=X'35' START ; ! NOT EDS100 OR EDS200
K=X'33'; ! FORCE EDS100 PROPS PROTEM
M=(PT&15)<<4!STRM; ! TS AS DEVNO
MNEM=M'ZX'; ! 'SPARE' MNEMONIC
FINISH
DDT==RECORD(P_P2+NDISCS*DDTSIZE)
DDT=0
DDT_SER=X'300010'+NDISCS
DDT_PTS=PT<<4!STRM
DDT_PROPADDR=(K-X'33')*20; !DISPLACEMENT IN TABLE
DDT_MNEMONIC=MNEM<<16+HEXDS(M>>4)<<8+HEXDS(M&15)
DDT_MECH=M
DDT_PROPS=J
DDT_CHFISA=ISA
NDISCS=NDISCS+1
!MISS:
DUP: REPEAT
*LB_ISA; *LSS_2; *ST_(0+B ); ! MATERCLEAR AGAIN IN CASE ATTNS
RETURN
REINIT:
! P_P2=ADDR(CONTROLLER LIST)
! P_P3=DITADDR
! P_P4=NO OF DISCS
DITADDR=P_P3
NCONTROLERS=INTEGER(P_P2)
CYCLE I=1,1,NCONTROLERS; ! DOWN CONTROLLER LIST
INF=INTEGER(P_P2+4*I)
CCA==RECORD(X'80000000'!(INF&X'FFFF')<<18)
CCA=0; ! CLEAR COMMUNICATION AREA
PTR=ADDR(CCA)+(32+16*(INF>>16&15+1)); ! START OF RQBS (INF HAS HI STRM NO.)
CCA_MARK=-1
!
CYCLE J=0,1,NDISCS-1
DDT==RECORD(INTEGER(DITADDR+4*J))
PROP==RECORD(DDT_PROPADDR)
IF DDT_PTS>>4=INF>>24 START ; ! ON THE DFC
RQB==RECORD(PTR)
PTR=PTR+PROP_RQBLKSIZE
RQB_LSEGPROP=128<<18!X'C000';! PRIV & ACR=0
RQB_LSEGADDR=INTEGER(PST VA+PST SEG*8+4)&X'FFFFF80';! REAL ADR OF PST
SIZE=PROP_LBLKSIZE
RQB_LBPROP=X'18000000'+SIZE
RQB_LBADDR=PTR+12
INTEGER(PTR)=X'04010800'; ! CONNECT STREAM
INTEGER(PTR+4)=X'04400400'; ! READ PROPCODES
INTEGER(PTR+8)=X'00410102'; ! SENSE
PTR=PTR+SIZE+16
SIZE=PROP_ALISTSIZE
RQB_ALPROP=X'18000000'+SIZE
RQB_ALADDR=PTR+16
RQB_W6=X'FF00'; ! STATUS MASK ALLOW ALL
INTEGER(PTR)=SD+4; ! 4 BYTES OF PROPCODES
INTEGER(PTR+4)=ADDR(DDT_PROPS)
INTEGER(PTR+8)=X'58000030';! SENSE 48 BYTES(UP TO MECH7)
INTEGER(PTR+12)=RQB_ALADDR+128
PTR=PTR+SIZE+16
DDT_CCA=ADDR(CCA)
DDT_RQA=ADDR(RQB)
DDT_LBA=RQB_LBADDR
DDT_ALA=RQB_ALADDR
STRM=DDT_PTS&15
INTEGER(ADDR(CCA_STRMS(STRM))+4)=ADDR(RQB)
FINISH
REPEAT
!
! HAVE SET UP DDT FOR ALL DEVICES ON THIS CONTROLLER
! SO NOW INITIALISE IT
!
REINIT AGAIN:
CCA_PAW=X'04000000'; ! DO CONTROLLER REQUEST
CCA_CSAW1=X'32000014'; ! NO TERMINATION INT
! REAL ADDRESS RREQUIRED. SUBTRACT SEGNO AND ADD GLA SEG BASE
CCA_CSAW2=REALISE(ADDR(INIT))
INIT_W0=((INTEGER(PST VA+PST SEG*8)&X'FFFC'+X'80')//8-1)<<18!X'80000000'
INIT_W1=INTEGER(PST VA+PST SEG*8+4)&X'0FFFFF80'
INIT_W2=(INF&X'FFFF')<<18!X'80000000'
ICA==RECORD(REAL0ADDR); ! REAL ADDR 0
!
!COPY 10 WORDS OC CCA TO REAL ADDRESS 0 AND INITIALISE
!
CYCLE J=0,4,36
INTEGER(ADDR(ICA)+J)=INTEGER(ADDR(CCA)+J)
REPEAT
CCA_PAW=0
CCA_CSAW1=0
PT=INF>>24
ISA=PT<<16!X'40000800'
*LB_ISA; *LSS_1; *ST_(0+B )
!
! MUST WAIT TILL CONTROLLER HAS FINISHED WITH REAL ADDRESS 0 BEFORE
! TRYING TI INITIALISE THE NEXT CONTROLLER
!
J=0
WHILE CCA_CRESP1=0 OR CCA_MARK#-1 CYCLE
J=J+1
IF J>=TIMEOUT START
OPMESS("DFC REINIT fails ".HTOS(PT,2))
DUMPTABLE(10,REAL0ADDR,32)
DUMPTABLE(11,ADDR(CCA),32)
IF FAILCOUNT<4 START
*LB_ISA; *LSS_2; *ST_(0+B )
FAILCOUNT=FAILCOUNT+1
WAIT(100*FAILCOUNT)
->REINIT AGAIN; ! HAVE ANOTHER SHOT
FINISH
EXIT
FINISH
REPEAT
CCA_CRESP1=0; CCA_CRESP2=0
REPEAT
RETURN
INTEGERFN PROPCODES(INTEGER STRM)
INTEGER K
INTEGER(X'200'+TEMP CA)=X'04010800'
INTEGER(X'204'+TEMP CA)=X'00000400'
INTEGER(X'210'+TEMP CA)=SD+X'2C'
INTEGER(X'214'+TEMP CA)=X'240'+TEMP CA
AD=ADDR(CCA_STRMS(STRM))
INTEGER(AD)=X'10000024'
INTEGER(AD+4)=ADDR(RQB)
INTEGER(AD+8)=0
INTEGER(AD+12)=0
INTEGER(X'240'+TEMP CA)=-1; ! IN CASE NO PROPERTY CODES
CCA_MARK=-1
CCA_PIW1=0; CCA_PIW2=0
CCA_PAW=X'01000000'+STRM
*LB_ISA; *LSS_1; *ST_(0+B )
! WAIT FOR RESPONSE
WAIT: J=10000
WHILE INTEGER(AD+8)=0 OR CCA_MARK#-1 CYCLE
J=J-1
->MISS IF J=0
REPEAT
K=INTEGER(AD+8); ! RESPONSE
IF K>>22=0 START ; ! ATTENTION
PRINTSTRING("DISC stream ".HTOS(PT<<4!STRM,3). C
" Attention ".STRHEX(K)."
")
INTEGER(AD+8)=0
->WAIT
FINISH
J=INTEGER(TEMPCA+X'240')
PRINTSTRING("DISC stream ".HTOS(PT<<4!STRM,3)." responds ")
PRINTSTRING(STRHEX(K)." ".STRHEX(INTEGER(AD+12))C
." PROPS=".STRHEX(J)."
")
RESULT =K
MISS: RESULT =0
END
END
EXTERNALROUTINE DRUMGROPE(RECORD (PARMF)NAME P)
RECORDFORMAT STRF(INTEGER SAW0,SAW1,RESP0,RESP1); ! WITHIN COMM AREA
RECORDFORMAT ESCBF(INTEGER HQ,LQ,SAW0,PAWBS, ADDSTRS)
RECORDFORMAT DTENTF(INTEGER NSECS,CONTI,SPTRK,NEXT,STATE, C
INTEGERNAME MARK,PAW,PIW, C
RECORD (ESCBF)ARRAY ESCBS(0:31))
! IN FACT ONLY NECESSARY ESCBS ARE PRESENT.
RECORD (DTENTF)NAME DTAB0; ! MAPS ONTO FIRST ENTRY IN TABLE
RECORDFORMAT CONTABF(INTEGER ISCR,BATCH,INTEGERNAME MARK,CRESP0)
RECORD (CONTABF)ARRAYFORMAT CONTABAF(1:8)
OWNRECORD (CONTABF)ARRAY TCONTAB(1:8); ! TEMPORARAY (PHASE 1) CONTROLLER TABLE
RECORD (CONTABF)ARRAYNAME CONTAB; ! MAPPED TO FINAL POS IN DTAB
RECORDFORMAT COMAF(INTEGER MARK, PAW, COUNTS, DRUMRQ, CAW0, C
CAW1, CRESP0, CRESP1, INTEGERARRAY PAWS, PIWS(0:7), C
RECORD (STRF)ARRAY STRS(0:127))
! NOW OWNS WHICH STORE PRINCIPAL
! PARAMETERS
OWNINTEGER DNEXTD,DCURRD; ! DISPLACEMENTS OF NEXT AND CURRENT DRUM TAB ENTRIES RESP.
OWNINTEGER TOTDSP; ! THE NUMBER OF KBYTES OF DRUM STORE AVAILABLE.
OWNINTEGER CONT1,CONT2; ! CONTAB INDICES FOR USE IN PHASE1 AND 2 RESP.
INTEGERNAME TSIZE; ! ==INTEGER(AREA), HOLDS AREA SIZE IN BYTES.
INTEGER NESECQS; ! ON A DRUM
INTEGER UTILISATION; ! OF DRUM SPACE ON SFC
INTEGER PT, MN; ! PORT/TRUNK, MECHANISM NUMBER
INTEGER SECINC,PROPCODE
INTEGER EPN; ! = EPAGESIZE
INTEGER TCAD; ! TEMPORARY COMMUNICATION AREA ADRRESS.
INTEGER MAXMN; ! MAX ON GIVEN SFC => SIZE OF COMM AREA.
INTEGER CAD; ! FINAL COMM AREA ADDRESS.
INTEGER CASIZE
INTEGER STRI,ESEC; ! INDICES INTO COMM AREA, AND DTENT
INTEGER PAWBS,SAW0; ! ESCB VALUES
INTEGER SLINK; ! LINK SAVE
STRING (30) REPORT; ! MESSAGE FOR OPER SCREEN
RECORD (COMAF)NAME CA
RECORD (DTENTF)NAME DTENT
RECORD (DTENTF)NAME DTENT2,DTENT3; ! FOR TABLE TIDY
RECORD (CONTABF)NAME CTENT
RECORD (CONTABF)NAME TCTENT
RECORD (ESCBF)NAME ESCB
CONSTINTEGER CONTROL=X'800'; ! TRUNK IMAGE STORE ADDRESS
! CONSTANTS WHICH DEFINE COMM AREA PATTERNS
CONSTINTEGER PWFCR=X'04000000'
CONSTINTEGER CRFINIT=X'32000004'
CONSTINTEGER CRFDRUMRQ=X'3A000004'
CONSTINTEGER CRFRSTATUS=X'31000014'
CONSTINTEGER DRFRPC=0; ! FOR COMPLETENESS!!
CONSTINTEGER DRFWFMT=X'01000000'
CONSTINTEGER DRFCONN=X'05000000'
CONSTINTEGER DRFERRC=X'0700000F'; ! TO MAX OF 15
! NOW REPLY BITS
CONSTINTEGER NT=X'00800000'; ! NORMAL TERMINATION
CONSTINTEGER AUTO=X'80',AVAIL=8; ! IN SAME PLACE.
CONSTINTEGER SFLAGS= X'A2000000'; ! SAW FLAGS FOR COMM AREA STREAMS
! PROPERTIES OF VARIOUS DRUM TYPES
CONSTBYTEINTEGERARRAY SECSPTRK(1:4)=16,24,24,11; ! SECTORS PER TRACK
CONSTINTEGERARRAY TRKSPDRUM(1:4)=128,256,256,512; ! TRACKS PER DRUM
CONSTINTEGERARRAY SECSPDRUM(1:4)=X'800',X'1800',X'1800',X'1600'; ! SECTORS PER DRUM
CONSTINTEGER CABASIC=96 ; ! SIZE OF COMM AREA(BYTES)
! BASIC IE WITHOUT ANY DRUMS
CONSTINTEGERARRAY BPMECH(1:4)=512(3),256;! BYTES COMM PER MECHNSM
! NOW NECESSARY ROUTINE SPECS
ROUTINESPEC LOADUPROG(INTEGER PT); ! LOADS MICROPROGRAM TO PORT
! AND TRUNK GIVEN, PLUS
! SETS IN INITIAL ADDRESSING MODE.
ROUTINESPEC FEEL FOR(INTEGER PT, MN, CAD)
! ESTABLISHES PRESENCE OR NOT
! OF EACH MECHANISM.
ROUTINESPEC MOVE(INTEGER PT, OLDCA, NEWCA)
! MOVES COMMUNICATION AREA
ROUTINESPEC DO IT(INTEGER TIME, PT, RECORD (COMAF)NAME CA)
! DO A CONTROLLER REQUEST
! ON PORT, TRUNK VIA COMM AREA.
SWITCH PHASE(1:3); ! POFF SWITCH
PT=P_P1<<16!X'40000000'; ! NOW IMAGE STORE ADDRESS
TSIZE==INTEGER(P_P2)
DTAB0==RECORD(P_P2+4)
TCAD=P_P3
EPN=EPAGESIZE
->PHASE(P_DEST)
!
PHASE(1): ! P1=PT, P2=AREA, P3=TCAD
! LOAD MICROPROGRAM AND GET INTO INITIAL ADDRESSING
! MODE.
LOAD UPROG(PT)
INTEGER(REAL0ADDR)=-1; ! SET MARK
WAIT(1); ! GUARANTEE WRITTEN THROUGH
MOVE(PT,REAL0ADDR,TCAD); ! MOVE COMM AREA FROM INIT TO TCAD
REPORT=""
MAXMN=-1; ! FEEL FOR DRUMS ON THIS SFC
CYCLE MN=0,1,3
FEEL FOR(PT,MN,TCAD)
REPORT=REPORT.STRINT(MN)."," IF MAXMN=MN; ! FOUND THIS ONE
REPEAT
IF MAXMN>=0 START
CA==RECORD(TCAD)
CA_DRUMRQ=DRFERRC
CA_CAW0=CRFDRUMRQ
DO IT(5,PT,CA)
! THAT SETS ERROR COUNT ON THIS SFC
CASIZE=CABASIC+(MAXMN+1)*BPMECH(PROPCODE)
CONT1=CONT1+1; ! MAKE A NEW CONTAB ENTRY
TCONTAB(CONT1)_ISCR=PT+CONTROL
TCONTAB(CONT1)_BATCH=0; ! REST FILLED AND MOVED IN PHASE 2
! FORM REPORT FOR THIS SFC
LENGTH(REPORT)=LENGTH(REPORT)-1; ! DELETE TRAILING COMMA
REPORT=REPORT." ".STRINT(UTILISATION)."%"
FINISH ELSE START
REPORT=" none"
CASIZE=0
FINISH
REPORT="SFC PT".HTOS(PT>>16,2)." DRUMS ".REPORT
OPMESS(REPORT)
! SET UP REPLY
P_P5=TOTDSP
P_P6=CASIZE
RETURN
! ON RETURN FROM ACTIVITY 1 :-
! P5= NUMBER OF DRUM PAGES SO FAR
! P6= FINAL SIZE OF THIS SFC COMM AREA
!
PHASE(2): ! P1=PT, P2=AREA, P3=TCAD, P4=CAD
!
! SET UP REMAINING DTAB AND CONTAB ENTRIES FOR THIS SFC
! CONT2 DETERMINES WHICH CONTAB ENTRY I.E. ASSUMES ORDER IN
! PHASE1 AND PHASE 2 ARE THE SAME.
!
CAD=P_P4
MOVE(PT,TCAD,CAD); ! TO FINAL POSITION
CA==RECORD(CAD)
CONTAB==ARRAY(P_P2 + DNEXTD,CONTABAF); ! I.E. IMMEDIATELY FOLLOWING LAST DRUM ENTRY
CONT2=CONT2+1; ! THE CURRENT ENTRY
CTENT==CONTAB(CONT2)
TCTENT==TCONTAB(CONT2)
TCTENT_MARK==CA_MARK; ! FORM COMPLETE CONTAB ENTRY
TCTENT_CRESP0==CA_CRESP0; ! IN TEMP CONTAB
CTENT=TCTENT; ! AND COPY TO FINAL POSITION
!
! FIND EACH DRUM ON THIS SFC AND FILL ENTRY
DTENT==DTAB0
DTENT==RECORD(P_P2+DTENT_NEXT) WHILE DTENT_CONTI#CONT2
! NOW FOUND FIRST SUCH DRUM, REST FOLLOW
CYCLE
ESCB==DTENT_ESCBS(0)
MN=ESCB_HQ; ! FROM PHASE1
NESECQS=ESCB_LQ
PROPCODE=ESCB_SAW0
! SET UP REFERENCES
DTENT_MARK==CA_MARK
DTENT_PAW==CA_PAWS(MN)
DTENT_PIW==CA_PIWS(MN)
! THEN ESCBS
IF PROPCODE#4 THEN STRI=MN<<5 ELSE STRI=MN<<4;! 32 0R 16
SAW0=SFLAGS!MN<<21
PAWBS=(-1)<<(32-EPN); ! EPN BITS RIGHT JUSTIFIED IN A WORD
SECINC=EPN<<16
CYCLE ESEC=0,1,NESECQS-1
ESCB==DTENT_ESCBS(ESEC)
ESCB_HQ=0
ESCB_LQ=0
ESCB_SAW0=SAW0
ESCB_PAWBS=PAWBS
ESCB_ADDSTRS=ADDR(CA_STRS(STRI))
SAW0=SAW0+SECINC
PAWBS=PAWBS>>EPN
STRI=STRI+EPN
REPEAT
! RECORD INFO FOR DRUM
ESCB==DTAB0_ESCBS(0)
ESCB_HQ=DNEXTD; ! THE DISPLACEMENT OF CONTAB
ESCB_LQ=CONT2; ! THE HIGHEST INDEX (SO FAR)
!
EXITIF DTENT_NEXT=0
DTENT==RECORD(P_P2 +DTENT_NEXT)
EXITIF DTENT_CONTI # CONT2
REPEAT
! NOW TIDY UP
TSIZE=ADDR(CONTAB(CONT1+1))-ADDR(TSIZE)-4; ! N.B. BYTES!!!!!!!!!!
RETURN
!
PHASE(3): ! TIDY TABLE (TO SPREAD LOAD ACCROSS SFCS)
DTENT==DTAB0
UNLESS DTENT_NEXT=0 START ; ! CRUDE VERSION PROTEM
DTENT2==RECORD(P_P2+DTENT_NEXT)
UNLESS DTENT2_NEXT=0 OR DTENT_CONTI#DTENT2_CONTI START
DTENT3==RECORD(P_P2+DTENT2_NEXT)
SLINK=DTENT_NEXT
DTENT_NEXT=DTENT2_NEXT
DTENT2_NEXT=DTENT3_NEXT
DTENT3_NEXT=SLINK
FINISH
FINISH
RETURN
!
!
ROUTINE FEEL FOR(INTEGER PT, MN, CAD);! IS THERE A DEVICE OUT THERE??
RECORD (DTENTF)NAME DTENT
RECORD (COMAF)NAME CA
RECORD (ESCBF)NAME ESCB
INTEGERARRAYNAME STATE; ! MAPPED ONTO CA_PAWS, NON-SLAVED
! DESTINATION FOR STATUS INFO - 5 WORDS.
INTEGERNAME PC; ! SIMILAR DESTINATION FOR PROPERTY CODE
! MAPPED TO STATE(5).
INTEGER SPTRK; ! SECTORS PER TRACK.
! IF IT FINDS A DEVICE THIS ROUTINE
! FILLS IN THE DEVICE TABLE ENTRY (DTENT)
! AND UPDATES LDEVMAX AND ADDLIM ACCORDINGLY.
MN=MN<<21; ! POS FOR USE IN COMM AREA.
CA==RECORD(CAD)
STATE==CA_PAWS
PC==STATE(5); ! I.E. AFTER STATUS INFORMATION
! FIRST READ DEVICE STATUS
STATE(1)=0; ! I.E. NOT AVAILABLE
CA_CAW0=CRFRSTATUS!MN
CA_CAW1=REALISE(ADDR(STATE(0)))
DO IT(5,PT,CA)
! EXAMINE STATUS READ TO DETERMINE
! DEVICE TYPE AND CONDITION
PRINTSTRING("DRUM".HTOS(PT<<4!MN>>21,3)." reports ")
PRHEX(STATE(0)); PRHEX(STATE(1)); NEWLINE
RETURNIF STATE(1) & AUTO=0
IF STATE(1)&AVAIL=0 THEN C
OPMESS("DRUM".HTOS(PT<<4!MN>>21,3)." has warning bits")
! THERE IS ONE OUT THERE AND IT'S GOING
! NOW READ PROPERTY CODE (PC)
PC=0; ! IN CASE OF ANY FAILURE
CA_DRUMRQ=DRFRPC!MN
CA_CAW0=CRFDRUMRQ!MN
CA_CAW1=REALISE(ADDR(PC))
DO IT(5,PT,CA)
PC=PC>>24; ! 1,2,3 INDEXES PROPERTY TABLES
UNLESS 1<=PC<=4 START
OPMESS("Invalid PROP. CODE =".HTOS(PC,2))
RETURN
FINISH
PROPCODE=PC
CA_DRUMRQ=DRFCONN!MN; ! NOW CONNECT THIS DEVICE
CA_CAW0=CRFDRUMRQ!MN
DO IT(5,PT,CA)
! AND FORMAT THE LOT
CA_DRUMRQ=DRFWFMT!MN
CA_CAW0=CRFDRUMRQ!MN-4+SECSPDRUM(PC); ! ALL SECTORS ON DRUM
DO IT(4000,PT,CA)
! ESTABLISH THIS DRUM
NESECQS=SECSPTRK(PC)//EPN
IF DCURRD#0 START ; ! LINK NEW INTO PREVIOUS
DTENT==RECORD(P_P2 + DCURRD)
DTENT_NEXT=DNEXTD
FINISHELSESTART
DNEXTD=4
FINISH
DCURRD=DNEXTD
DTENT==RECORD(P_P2 +DCURRD)
DNEXTD=ADDR(DTENT_ESCBS(NESECQS)) - P_P2
! FILL IN BASIC SCALARS
DTENT_NEXT=0; ! MAY BE LAST DRUM
SPTRK=NESECQS*EPN
DTENT_SPTRK=SPTRK
DTENT_NSECS=SPTRK*TRKSPDRUM(PC)
DTENT_STATE=0
DTENT_CONTI=CONT1+1; ! PHASE1 INDEX
! REFERENCES ARE FILLED IN PHASE 2
! REMAINS TO SET GLOBAL PARAMETERS
MN=MN>>21; ! CONVENTIONAL POSITION
MAXMN=MN
TOTDSP=TOTDSP+DTENT_NSECS
UTILISATION= DTENT_NSECS*100// SECSPDRUM(PC)
! AND TO RECORD FOR PHASE2:-
ESCB==DTENT_ESCBS(0)
ESCB_HQ=MN
ESCB_LQ=NESECQS
ESCB_SAW0=PROPCODE
END ; ! OF FEEL FOR
!
!
ROUTINE MOVE(INTEGER PT, OLDCA, NEWCA); ! MOVES MARK (COMM AREA)
RECORDFORMAT SHORTCAF(INTEGER MARK,PAW,CNTS,DRQ,CAW0,CAW1, C
CRESP0,CRESP1,INTEGERARRAY PAWS,PIWS(0:7))
RECORD (SHORTCAF)NAME CA
INTEGER MARKAD
CA==RECORD(OLDCA)
CA_PAW=PWFCR
CA_CAW0=CRFINIT
CA_CAW1=REALISE(NEWCA)
CA_CRESP0=0
! ENSURE SLAVE INTERLOCK
MARKAD=ADDR(CA_MARK)
*LXN_MARKAD
*INCT_(XNB ); *TDEC_(XNB )
! PREPARE NEW SITE
CA==RECORD(NEWCA)
CA_MARK=-1
WAIT(1); ! FOR WRITE THROUGH.
DO IT(5,PT,CA)
! NOW CLEAR PAWS & PIWS
CA=0; ! WILL CLEAR EVERYTHING, ESP PAW,PAWS & PIWS
CA_MARK=-1
END ; ! OF MOVE
ROUTINE DO IT(INTEGER TIMESLOTS, PT, RECORD (COMAF)NAME CA)
! DOES A CONTROLLER REQUEST
! ON THIS SFC (PT)
INTEGER MARKADD, ISA, CRESP0
! TIMESLOTS ARE 10MS PERIODS.
! HEAVY USE OF M/C IN ORDER TO ENSURE
! THE ABOLITION OF SLAVERY.
MARKADD=ADDR(CA_MARK)
ISA=PT+CONTROL
! CLAIM SEMA
*LXN_MARKADD; ! SHOULD INVARIABLY BE FREE, BUT MUST
LAB1: *INCT_(XNB ); ! ENSURE SLAVES CLEARED THROUGH.
*JCC_7, <LAB1>; ! LOOP UNLESS CC=0=MARK.
CA_PAW=PWFCR
CA_CRESP0=0; ! CLEAR FOR REPLY
! SEND FLAG BEFORE RELEASING SEMA, ENSURES
*LB_ISA; ! WRITES THROUGH BEFORE ACCESS BY SFC.
*LSS_1
*ST_(0+B )
! RELEASE SEMA
*LXN_MARKADD
*TDEC_(XNB ); ! SFC CLAIMS BY READ AND CLEAR, HENCE TDEC
! GUARANTEED TO RELEASE.
UNTIL CRESP0#0 OR TIMESLOTS=0 CYCLE
WAIT(2)
TIMESLOTS=TIMESLOTS-1
! ENSURE CRESP0 READ FROM REAL STORE
*LXN_MARKADD
LAB2: *INCT_(XNB )
*JCC_7, <LAB2>
CRESP0=CA_CRESP0
*LXN_MARKADD
*TDEC_(XNB )
REPEAT
IF CRESP0#0 START ; ! IF GENUINE RESPONSE
IF CRESP0#NT START
OPMESS("SFC request fails")
OPMESS(STRHEX(CA_CRESP0)." ".STRHEX(CA_CRESP1))
FINISH
CA_CRESP0=0; ! LET NORMAL WRITE THROUGH APPLY
FINISH ELSE START
OPMESS("SFC Time out ")
OPMESS(STRHEX(CA_PAW)." ".STRHEX(CA_CAW0))
FINISH
END ; ! OF DO IT
ROUTINE LOAD UPROG(INTEGER PT)
ROUTINESPEC WAITAFB(INTEGER ISDIAG); ! WAIT FOR ACKNOWLEDGE FROM B
! SFC MICROPROGRAM VERSION 941 DATED 29NOV78
!
! THIS VERSION FIRST USED IN CHOPSUPE 18E
! PREVIOUSLY VSN 940 USED FROM 15JAN78
ENDOFLIST
CONSTINTEGERARRAY UPA(0:X'200')=C
X'3006E841',X'0C829041',X'00018782',X'00032C22',
X'00014003',X'00031874',X'22601141',X'0001D041',X'86803951',
X'86858041',X'22601141',X'A0103941',X'00029041',X'0001004C',
X'86803901',X'0881E841',X'A0136841',X'0F00E8C1',X'22605041',
X'0002DF62',X'00051844',X'00000044',X'0000F4A3',X'00028042',
X'8004F462',X'80801157',X'2260417A',X'86803941',X'30003906',
X'00008841',X'0000907E',X'A00B3840',X'0000A879',X'0000115E',
X'0810E87B',X'0000A876',X'00010079',X'0002E876',X'0000A873',
X'0000A872',X'0002780B',X'0001D07D',X'00050873',X'0000F072',
X'0000F871',X'0000A86C',X'0000A86B',X'0000A86A',X'50003941',
X'0002C041',X'00001940',X'00031846',X'A0705815',X'0000EA7D',
X'00028003',X'00031F42',X'000284E7',X'000004E7',X'0DE00034',
X'2260212C',X'0C81C833',X'0001D82F',X'0001B823',X'81040041',
X'0E024041',X'00012041',X'000209C1',X'84040041',X'0001E9E8',
X'00000040',X'0001B045',X'0001E045',X'000251C5',X'0001F9C6',
X'000201C6',X'86803961',X'64103960',X'8406D041',X'6390395E',
X'8400395D',X'84003941',X'00032AC1',X'0002F84A',X'8400393A',
X'000000C1',X'80000041',X'00000402',X'0000F83E',X'2260111A',
X'0DE00041',X'00008042',X'0000E87C',X'0000F056',X'00000482',
X'00000071',X'0002C041',X'00000040',X'0001D045',X'0000116F',
X'00004171',X'0002E87C',X'80802174',X'06808841',X'00000764',
X'00027041',X'20E00041',X'00091841',X'0000800F',X'0002E483',
X'0002F841',X'00032861',X'00026841',X'0002C02B',X'80048036',
X'22604149',X'00036040',X'22601136',X'86050852',X'000249CF',
X'3007003B',X'2260113B',X'0001003F',X'0001084D',X'0002F0C1',
X'80000041',X'0001EC02',X'0000020C',X'80802141',X'000000C1',
X'00000442',X'0002C00F',X'00000204',X'00011812',X'84050841',
X'0001E9C1',X'22601141',X'0001D041',X'86803941',X'A0103941',
X'00023041',X'00023841',X'0000A041',X'20E0113B',X'00008841',
X'0DE00036',X'00026041',X'80003941',X'00026839',X'000080C1',
X'80026841',X'0F80003A',X'0000115A',X'0000803C',X'0000A8E5',
X'0000FAC1',X'00031041',X'0003302A',X'0000A02B',X'0000F82C',
X'0D900007',X'00044141',X'820CE841',X'090890C6',X'2262E483',
X'81840041',X'00011816',X'00044141',X'000C00C1',X'8006C041',
X'0C826840',X'00015007',X'00016008',X'81857782',X'00011815',
X'00014041',X'0001200C',X'000518BF',X'00014841',X'0002E484',
X'00000024',X'0002C041',X'00003940',X'84826802',X'00015805',
X'00016806',X'0000EF82',X'00000022',X'0001400A',X'00048838',
X'00051820',X'20E33442',X'00002143',X'80800241',X'00002128',
X'000D98C1',X'80040041',X'80801141',X'50003941',X'0F03852D',
X'00005AC1',X'00033840',X'0901004D',X'0900F04C',X'0900F04B',
X'0900F84A',X'0900F849',X'0900E848',X'0900E847',X'09822038',
X'84003941',X'0002383A',X'30040034',X'00007041',X'0000833B',
X'8106F841',X'0E024041',X'8186C041',X'0E021040',X'00000020',
X'0000833D',X'A0600908',X'00026841',X'A060110D',X'0003304C',
X'80808040',X'00002152',X'00002146',X'20E10027',X'00000001',
X'20E10829',X'0000A062',X'00006288',X'20E2E8C1',X'0000CC42',
X'00002142',X'0000580B',X'20E128C1',X'0002AE87',X'0000B662',
X'20E0213F',X'80801141',X'50003941',X'20E00035',X'000231FA',
X'0000EF67',X'00042141',X'000D4841',X'848490C1',X'80022041',
X'00000405',X'0000F044',X'80801141',X'50003941',X'00001916',
X'60100041',X'0C880402',X'00028841',X'00015786',X'0002C041',
X'0000B040',X'0DE13014',X'00031841',X'0000A5AE',X'22614012',
X'20E23041',X'00001141',X'84003941',X'0002380E',X'0D9220C1',
X'C1E01141',X'8206F041',X'30003941',X'21E01141',X'0001C041',
X'86803941',X'30003941',X'8504C041',X'20E04141',X'00014841',
X'44B2F041',X'0C840402',X'850400C2',X'00029001',X'20E01141',
X'00015742',X'00028041',X'60303919',X'00000545',X'00000443',
X'000231CC',X'00000545',X'80802149',X'00000443',X'80801141',
X'50003904',X'0000002A',X'00000041'(3),X'0000A54F',X'000231C1',
X'8402B765',X'5D09E841',X'0E857CE3',X'8500B841',X'000404C2',
X'0002380A',X'22200041',X'209890C1',X'0006FC42',X'00004147',
X'0000A4E3',X'80802141',X'A0100084',X'20E230C1',X'00001141',
X'8400391D',X'22100041',X'0004E0C1',X'09002141',X'80040041',
X'00011CF3',X'0E021D22',X'0F0080C2',X'30048038',X'8004F6E2',
X'0DE22039',X'0880A041',X'85055D66',X'44B00583',X'00022841',
X'0000E843',X'0C89A041',X'00016041',X'20E23041',X'00001141',
X'84003941',X'0000D041',X'80801141',X'50003944',X'818220C1',
X'00001141',X'8000395F',X'A0636841',X'00019841',X'0002D841',
X'000197A8',X'8106C041',X'00017840',X'00001943',X'A0500941',
X'00007041',X'8504BCD8',X'8080EAC2',X'81057805',X'00031041',
X'00033341',X'00002141',X'0001E841',X'000000C1',X'00016C47',
X'8584A5B4',X'44B08041',X'5C895DF0',X'81040041',X'0E90062F',
X'81801142',X'00002108',X'8584D841',X'61603941',X'64B17041',
X'0C86C041',X'000160C0',X'0000A079',X'800402C1',X'08800070',
X'2220F041',X'20980051',X'0904A032',X'0E840041',X'C1E01151',
X'81801141',X'00008615',X'64B005C7',X'0C840041',X'C2E17041',
X'669AC041',X'61183940',X'0000A06A',X'0000000F',X'C162C041',
X'66983940',X'0000A066',X'00000013',X'808802C1',X'00031041',
X'0003306D',X'30003941',X'21E01141',X'0001C041',X'86803941',
X'0001F041',X'80040046',X'0002C041',X'81003940',X'00000007',
X'82001141',X'80003909',X'0880C1C1',X'84003941',X'85854841',
X'20E04141',X'44B17041',X'0C855C02',X'858550C2',X'00029001',
X'20E01141',X'60303941',X'44B00742',X'00028041',X'0C86C041',
X'000162C0',X'00000047',X'82000763',X'00000642',X'0002F82F',
X'00001141',X'81003941',X'00022041',X'0000A041',X'20E23041',
X'00001141',X'84003941',X'80801141',X'50003941',X'00001941',
X'00031841',X'00023CE7',X'00009442',X'A0104144',X'808004E4',
X'00002141',X'00000084',X'221000C3',X'00031B41',X'0000ED65',
X'00051B41',X'00002141',X'00000041',X'80056CE6',X'0E021D28',
X'0F01E8C1',X'00031EE2',X'300485CC',X'00000569',X'8201E8C1',
X'00001141',X'80003956',X'3005E841',X'0000E0C1',X'0DE22041',
X'0E908041',X'C2601141',X'30003941',X'22601141',X'0002F041',
X'0001C041',X'86803941',X'30003941',X'8504C041',X'20E04141',
X'00014841',X'44B00041',X'0C856841',X'850550C1',X'20E01141',
X'60303941',X'0002F742',X'00028041',X'00031AC1',X'0000ED69',
X'00000000'(28),X'00D20941',X'84640616',X'84640716',X'F2B24B72'
LIST
INTEGER I, ISA, DATA, COMM, DCM FAIL
INTEGER MSH, LSH; ! WILL LOAD THE SFC MICROPROGRAM
! IN UPA INTO SFC ON GIVEN
! PORT AND TRUNK
! FIRST DEFINE IMAGE STORE ADDRESSES
CONSTINTEGER CONTROL=X'800'
CONSTINTEGER DIAGSTAT=X'D00'
CONSTINTEGER ISDIAG=X'E00'; ! THESE ARE THE 3 NECESSARY AND SUFFICIENT
! REGISTERS
! NOW SOME VALUES WHICH ARE SENT TO ABOVE
CONSTINTEGER MCLEAR=2
CONSTINTEGER DCMBIT=X'400'; ! DCM BIT IN DIAG STAT
CONSTINTEGER NOTDCM=X'FFFFFBFF'; ! ¬DCMBIT!!
CONSTINTEGER AFB=X'800'; ! WAIT FOR THIS AFTER SENDING
CONSTINTEGER CLEARTOSEND=X'E80'; ! ISDIAG:- CLEAR FB'S SEND RFA
CONSTINTEGER CLEAR FOR NEXT=X'E00'; ! ISDIAG:- CLEAR FB'S
! NOW SOME USEFUL MASKS
CONSTINTEGER UH=X'FFFF0000'
! THE ONLY DIRECT MODE COMMAND NEEDED
CONSTINTEGER WIDCOM=X'A200'
! FIRST MASTER CLEAR SFC
ISA=PT+CONTROL
*LB_ISA; *LSS_MCLEAR; *ST_(0+B )
! NOW GET INTO DIRECT CONTROL MODE
ISA=PT+DIAGSTAT
*LB_ISA
*LSS_(0+B ); *OR_DCMBIT; *ST_(0+B ); ! OR IN DCM BIT
! NOW WRITE MICROPROGRAM
ISA=PT+ISDIAG
DCM FAIL=0
CYCLE I=0,1,511
DATA=UPA(I)
MSH=DATA&UH!CLEAR TO SEND
LSH=DATA<<16!CLEAR TO SEND
COMM=(WIDCOM+I)<<16!CLEAR TO SEND
! DATA PREPARED NOW WRITE
*LB_ISA; *LSS_COMM
*ST_(0+B ); WAITAFB(ISA)
*LB_ISA; *LSS_MSH
*ST_(0+B ); WAITAFB(ISA)
*LB_ISA; *LSS_LSH
*ST_(0+B ); WAITAFB(ISA)
REPEAT
! NOW SET THE MICROPROGRAM LOADED
! INDICATOR
COMM=(WIDCOM+X'200')<<16!CLEAR TO SEND
*LB_ISA; *LSS_COMM
*ST_(0+B ); WAITAFB(ISA)
*LB_ISA; *LSS_CLEARTOSEND
*ST_(0+B ); WAITAFB(ISA)
*LB_ISA; *LSS_CLEARTOSEND
*ST_(0+B ); WAITAFB(ISA)
IF DCM FAIL#0 THEN PRINTSTRING("
SFC MP FLAGS=".HTOS(DCM FAIL,4)."
")
! RETURN FROM DIRECT CONTROL MODE
! FIRST CLEAR DOWN FB'S IN ISDIAG
*LB_ISA; *LSS_CLEAR FOR NEXT; *ST_(0+B )
ISA=PT+DIAGSTAT; ! CLEAR DCMBIT IN DIAG STAT
*LB_ISA
*LSS_(0+B ); *AND_NOTDCM; *ST_(0+B );! CLEAR DCM BIT
! THE ONLY SAFE WAY
! MASTER CLEAR AGAIN TO ENSURE
! SFC IN INT ADDRESSING MODE
ROUTINE WAITAFB(INTEGER ISDIAG)
!***********************************************************************
!* WAIT FOR ACKNOWLEGE FROM B (B IS SFC!) AFTER DIRECT WRITE *
!* PARAMETER IS APPROPRIATE TRUNK REGISTER *
!***********************************************************************
INTEGER I
AGAIN: ! INCLUDE RELOADING B AS DELAY
*LB_ISDIAG
*LSS_(0+B )
*ST_I
*AND_AFB; ! ??????? AFB ACCESSIBLE ????????
*JAT_4,<AGAIN>
DCM FAIL=DCM FAIL!(I&X'1FF'); ! ALL FFBS AND PARITY FAILS
END ; ! OF WAITAFB
END ; ! OF LOAD UPROG
END ; ! OF DRGROPE
FINISH
ENDOFFILE