CONSTSTRING (25) VSN="GPC40 15th Mar 1982"
!************************************************GPC GPC GPC
!*
!* EMAS 2900 SUPERVISOR NOTE
!* No: 5
!* Date: 21/05/80
!* Author: A.Gibbons
!*
!*
!* %EXTERNAL ROUTINE GPC(%RECORD(PARMF)%NAME P)
!*
!* 1. CONVENTIONS
!* The record spec for the parameter is
!* %RECORDFORMAT PARMF(%INTEGER DEST,SRCE,P1,P2,P3,P4,P5,P6)
!* where
!* DEST is considered as two half words DSNO and DACT. DSNO
!* must be GPC's DSNO
!* DACT is set according to the function required.
!*
!* SRCE is considered as two halfwords SSNO and SACT.
!* SSNO is SNO of ORIGINATOR and SACT is DACT for
!* the reply.
!*
!* DEVICE ENTRIES
!* Each device on a GPC is allocated an area (a Device Entry) at
!* GROPE time. The address of the Device Entry is given by GPC
!* in P_P3 each time a response is generated for ALLOCATE,
!* DE-ALLOCATE, EXECUTE and INTERRUPT. The format of the Device
!* Entry is given elsewhere.
!*
!*
!*
!*
!* 2. INPUTS TO GPC
!*
!* DACT = 2 INITIALISATION. This must be the first call
!* P1 = ADDR of preprepared CONFIG TABLE
!* P2 = address of PROCESS LIST picture
!* DEST must contain SNO for GPC
!* For each OPER, GPC pons an allocate message to
!* itself with
!* P2 = X'320005'
!* SRCE = X'320002' ! OP<<8
!* For each FE, GPC pons an allocate message to itself
!* with
!* P2 = X'390005
!* SRCE = X'390002'
!* For each TAPE stream, GPC pons a message
!* DEST = X'310004'
!* SRCE = X'300000'
!* P1 = mnemonic
!*
!*
!* DACT = 11 ALLOCATE DEVICE
!* P1 = Device Mnemonic
!* P2 = full DEST (i.e. DSNO+DACT) to be used for all
!* interrupt responses (ATTENTION, TERMINATION, PCI &RI)
!* RESPONSE
!* P1 = 0 success
!* 1 mnemonic invalid
!* 2 alreadt allocated
!* P2 = SNO for device to be used in EXECUTE
!* P3 = address of device entry
!* P6 = mnemonic
!* additionally, for an OPER :
!* D_X2 = buffer area address
!* D_RESP0 = number of screens
!* D_X1 = size of buffer area
!* NOTE: P4 & P5 are not changed and may be used by the
!* caller to hold data
!*
!*
!* DACT = 5 DE ALLOCATE DEVICE
!* P1 = device mnemonic
!* RESPONSE
!* P1 = 0 success
!* 1 mnemonic 'LP' not allowed
!* 2 mnemonic invalid
!* 3<<16!STATE device not allocated
!* 4 user attempting to dealloc system device
!* P3 = address of device entry
!*
!*
!* DACT = 12 EXECUTE CHAIN
!* P1 = RCB address
!* P2 = SNO for device returned by ALLOCATE in P2
!* P3 = RSD << 8 ! PAW FUNCTION << 4 ! SAWFLAGS
!* (RSD is one bit
!* 0 = no special action
!* 1 = if chain terminates abnormally, do
!* 'READ STREAMS CONTROLLER STATUS'
!* controller command. The four status bytes are
!* returned in P_P5)
!* P4 = an ident field to be returned in P_P6 of
!* interrupt responses.
!* RESPONSE
!* NOTE A response
!* is sent only if the call fails. The response to
!* a successful call is generated when an interrupt
!* is received
!* P1 = 1 SNO out of range
!* 2 device not ready
!* P2 = SNO i.e. P2 of request
!* P3 = address of device entry (only if P1 > 1)
!* P4 = 0
!* P5 = 0
!* P6 = ident i.e. P4 of request
!*
!*
!* DACT = 6 CLOCK INTERRUPT ENTRY, no parameters, no responses
!*
!*
!* DACT = 3 INTERRUPT ENTRY
!* P1 = PT (PORT + TRUNK)
!* RESPONSE
!* A message is ponned to the dest that was
!* supplied in P2 of the ALLOCATE
!* P1 = stream response word RESP0 with byte0
!* overwritten with device SNO as returned
!* by ALLOCATE
!* P2 = stream response word RESP1
!* for all interrupts except attentions,
!* RESP0 and RESP1 are also written to the
!* appropriate fields in the device entry.
!* If a chain has timed out, RESP1 is set
!* to -1.
!*
!* P3 = address of device entry
!* P4 = response analysis flags from the response
!* to SENSE command (RESP0 >> 16) relevant
!* only after an abnormal termination or timeout
!* if the rightmost byte does not indicate
!* successful termination, then the sense
!* information is suspect.
!* The sense information is pointed to by the field
!* SENS AD in the device entry. It is laid out as
!* SECONDARY STATUS, TERTIARY STATUS (as many bytes
!* as appropriate) and PRIMARY STATUS.
!* P5 = controller status, relevant only if RSD bit
!* was set in EXECUTE
!* P6 = ident i.e. P4 of most recent EXECUTE
!* The following logic may be used to analyse the
!* interrupt response:
!* integer INTERRUPT ANALYSIS FLAGS
!* INTERRUPT ANALYSIS FLAGS = P_P1 >> 20 & 15
!* if INTERRUPT ANALYSIS FLAGS = 1
!* then ATTENTION
!* else if INTERRUPT ANALYSIS FLAGS & X'C' > 0
!* then TERMINATION
!* else SOMETHING ELSE ie PCI, RI
!* fi
!* fi
!*
!*
!*
!*
!*
!* DACT = 8 SPECIAL ALLOCATE FOR USE BY ENTER & MAINLP, CALLED NOT PON'D
!* P1 = PTSM OR LP
!* P2 = DEST (If MAINLP)
!* RESPONSE
!* P1 = 0 success
!* 1 mnemonic invalid
!* 2 stream disconnected
!* P2 = SNO for device to be used in EXECUTE
!* P3 = address of device entry (unless P1 = 1)
!* P6 = mnemonic
!*
!*
!*
!*
!* DACT = 7 RE-CONFIGURE SAC
!* P1 = IDENT
!* P2 = SAC
!* RESPONSE
!* P1 = IDENT
!* P2 = 0 success
!* # 0 mnemonic (string(3)) of device in use on SAC
!*
!*
!* DACT = 1 GPC COMMAND
!* P1-P6 contain up to 23 characters of string
!* The forms recognised are:
!* GPC QS mnemonic
!* gives the current state of the device:
!* NOT ALLOC, READY, REQ FIRED, SNS FIRED, QUEUED or
!* DISCNCTED
!* GPC CDS mnemonic OFF
!* configures a device (stream) off (see Operations
!* Note )
!* GPC CDS mnemonic ON
!* GPC CDM mnem1 mnem2
!* Configures an ungroped device in or a groped device out
!* E.G. GPC CDM ZX0 LP1 or GPC CDM CR0 ZX1
!* GPC ?
!* gives the state of all the devices known to GPC
!*
!*
!*
!*
!*
!* 3. MESSAGES PRODUCED ON LOG (L) AND/OR OPER (O)
!* ***** OPER MESSAGES REMOVED 18/7/80 (JM)
!*
!* from 'CONNECT STREAMS'
!* (L ) GPC CONNECT STREAMS pts
!* (L ) (DIS)CONNECT STRMs RESP0=response
!* (L ) SAW FAILS=n PAW FAILS=n
!* (L ) ABN TERM FOR GPTSM gptsm
!*
!*
!* from 'GPC DUMP'
!* (L ) GPC INIT RES=response
!* from 'PAW NOT CLEARED'
!* (L ) GPC PAW NOT CLEARED PT=pt, PAW=paw
!* (L ) SAW NOT CLEARED
!* from 'READ STRM DATA'
!* (L ) GPC READ STRM DATA PTS=pts
!* (L ) CRESP0=response
!* FIRST ENTRY TO GPC
!* (L ) GPC VERSION identifier
!* WHEN TIMEOUT DETECTED
!* (LO) GPC TIMEOUT dev pt
!* from AN INVALID CALL ON GPC(ACT=7) DIS/RE-CONNECT STRM
!* (L ) GPC DIS/CONNECT DEV P2=i FLAG=f
!* from THE INTERRUPT HANDLER
!* (LO) GPC ABTERM pts dev response
!* (L ) GPC SPURIOUS INTERRUPT PTS=pts RESP0=response
!* MONITOR MESSAGES
!* (L ) GPC( IN): ptrec
!* (L ) GPC( OUT): ptrec
!* (L ) GPC( PONS): ptrec
!*!
!*
! EXTERNAL REFERENCES
!*
!*
RECORDFORMAT PARMF(INTEGER DEST, SRCE, P1, P2, P3, P4, P5, C
P6)
!*
EXTERNALINTEGERFNSPEC REALISE(INTEGER I)
EXTERNALROUTINESPEC SLAVESONOFF(INTEGER ONOFF); ! 0=OFF, -1=ALL ON
EXTERNALROUTINESPEC GET PSTB(INTEGERNAME PSTB0, PSTB1)
EXTERNALROUTINESPEC SEMALOOP(INTEGERNAME SEMA,INTEGER PARM)
EXTERNALROUTINESPEC CONTROLLER DUMP(INTEGER CONTYPE, PT)
EXTERNALROUTINESPEC WAIT(INTEGER MILLISECONDS)
EXTERNALROUTINESPEC DUMP TABLE(INTEGER TABNO, ADR, LEN)
EXTERNALROUTINESPEC PKMONREC(STRING (20)TXT,RECORD (PARMF)NAME P)
EXTERNALSTRINGFNSPEC HTOS(INTEGER I, PL)
EXTERNALROUTINESPEC PON(RECORD (PARMF)NAME P)
EXTERNALROUTINESPEC OPMESS( STRING (63) S)
SYSTEMROUTINESPEC MOVE(INTEGER LENGTH, FROM, TO)
IF MULTIOCP=YES START
EXTERNALROUTINESPEC RESERVE LOG
EXTERNALROUTINESPEC RELEASE LOG
FINISH
IF (MONLEVEL>>1)&1=YES START
! KMONNING REQUIRED
EXTRINSICLONGINTEGER KMON
CONSTINTEGER KMONNING = YES
FINISH ELSE START
CONSTINTEGER KMONNING = NO
FINISH
!*
CONSTINTEGER ABNORMAL TERMINATION=X'00400000'
CONSTINTEGER CONTROLLER DETECTED ERROR=X'00410000'
IF CSU FITTED=YES START
CONSTINTEGER CSU DEST=X'2A0000'
FINISH
CONSTINTEGER DISCONNECTED=5
CONSTINTEGER DO CONTROLLER REQUEST=X'04000000'
CONSTINTEGER DO STREAM REQUEST=X'01000000'
CONSTINTEGER ENDLIST=255
CONSTINTEGER FE=14
CONSTINTEGER GET STRM DATA=16
CONSTINTEGER PROCESSING INTERRUPT=1
CONSTINTEGER TIMING OUT=2
CONSTINTEGER GPC DEST=X'00300000'
CONSTINTEGER GPC SNO=X'30'
CONSTINTEGER INIT CONTROLLER=X'32000010'
! 3=NO TERM INTS
! 2= INIT
! 10=BYTE COUNT FOR INIT WORDS
CONSTINTEGER LIMIT=5
CONSTINTEGER LOAD MICROPROGRAM=X'08000000'
CONSTINTEGER LOID=X'6E'
CONSTINTEGER LP=6
CONSTINTEGER MT=5
CONSTINTEGER NORMAL TERMINATION=X'00800000'
CONSTINTEGER NOT ALLOCATED=0
CONSTINTEGER OK=0
CONSTINTEGER OP=8
CONSTINTEGER PRIV ONLY=X'00004000'
CONSTINTEGER QUEUED=4
CONSTINTEGER RA0AD=X'81000000'
CONSTINTEGER RCB BOUND=32
CONSTINTEGER READ STREAM DATA=7
CONSTINTEGER READ CONTROL STREAM STATUS=5
CONSTINTEGER READ STREAMS CONTROLLER STATUS=3
CONSTINTEGER READY=1
CONSTINTEGER REQUEST FIRED=2
CONSTINTEGER SENSE FIRED=3
CONSTINTEGER SLOTSI=32
CONSTINTEGER SPURIOUS LIMIT=100
CONSTINTEGER SU=13
CONSTINTEGER TICK INTERVAL=2
CONSTINTEGER TRUNKADDR=X'40000800'
CONSTSTRING (4)ARRAY COMMAND(1:LIMIT) = "QS ", "CDS ", "CDM ",
"? ", "SET "
CONSTSTRING (9)ARRAY STATES(0:5) = "not alloc",
"ready", "req fired", "sns fired", "queued", "discncted"
!*
OWNINTEGER CAAS BASE
OWNINTEGER GPCT BASE
OWNINTEGER LAST SLOT
OWNINTEGER LOPT,HIPT
OWNINTEGER MECHPT
OWNINTEGER NO OF GPCS
OWNINTEGER PT GPC BASE
OWNINTEGER PTS BASE
OWNINTEGER STRMQ BASE
OWNBYTEINTEGERARRAYNAME MECHSLOTS
OWNBYTEINTEGERARRAYNAME PTS TO SLOT
OWNBYTEINTEGERARRAYNAME PT TO GPC
OWNBYTEINTEGERARRAYNAME STRM Q
OWNINTEGERARRAYNAME CAAS
OWNINTEGERARRAYNAME TABLE
OWNINTEGERARRAYNAME STRM SEMAPHORE
OWNINTEGERARRAY SPURIOUS INTS(0:15)
OWNSTRING (63) WK
!*
EXTERNALINTEGER LP ILLCHAR=X'07'; ! ERCC VALUE (ALSO USED BY GROPE)
!*
!* LP repertoire addresses and lengths for each of 16 cartidge settings
OWNINTEGERARRAY REPERTOIRE A(0:15)
OWNINTEGERARRAY REPERTOIRE S(0:15)
!*
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'
!*
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'C06AA1D0',
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'EBBC75BD',
X'8CAEBFBE',X'B6AAFDFE',X'9DEE80DA',X'C06D6AD0'
!*
CONSTBYTEINTEGERARRAY LCLETTS(1:26)= C
X'81',X'82',X'83',X'84',X'85',X'86',X'87',X'88',X'89',
X'91',X'92',X'93',X'94',X'95',X'96',X'97',X'98',X'99',
X'A2',X'A3',X'A4',X'A5',X'A6',X'A7',X'A8',X'A9'
!*
!* GPC MICROPROGRAM FOLLOWS AS %OWNINTEGERARRAY GPCMPROG(0:511)
!* PROGRAM C03 PATCH LEVEL 5
ENDOFLIST
OWNINTEGERARRAY GPCMPROG(0:511)= C
X'F160F161',X'482049E0',X'4022802C',X'E80AF0C9',
X'000AD009',X'80054265',X'9320BE0A',X'100A8005',X'C213CAB3',
X'8025CA33',X'8223CA53',X'8275CAD3',X'8005CA93',X'80C2CA73',
X'8005CB34',X'8005CAF3',X'82FACAD4',X'80788005',X'C273C2D3',
X'80298005',X'C2B38213',X'8210182E',X'93088007',X'4820E00C',
X'740C500B',X'930FB725',X'F9C0F16C',X'DEEB21CC',X'EB4BE008',
X'29E82C8C',X'61CC2CAC',X'61EC4C6B',X'7968B795',X'F9C00CCC',
X'610CFC00',X'61ECFC00',X'70CC0825',X'818F8070',X'48400825',
X'C2D4CA93',X'804AA2D4',X'BC091005',X'CAD48059',X'C27383DC',
X'9062805F',X'B21AA27A',X'A29A82D9',X'B80983DF',X'10054989',
X'C2D48068',X'B2F4A2D4',X'C2F4B2F4',X'EA131013',X'C6732013',
X'98019205',X'98020835',X'C2738005',X'A2F44282',X'498C9205',
X'8005A83D',X'A9D4F3AC',X'DCAC200C',X'4BC0700E',X'090C4042',
X'B3ACE80E',X'240C5006',X'C00680B0',X'782CB795',X'F9C0A335',
X'AED45017',X'500C0C17',X'C073A9F4',X'F48C501F',X'640E080C',
X'500EC873',X'AAF40D15',X'500C4FE0',X'68972CF5',X'12E1EA57',
X'E017C274',X'80A6B795',X'F9C0A673',X'1059C033',X'80ACF800',
X'90BAC008',X'BA0ACAF4',X'80054065',X'80DC4BE0',X'BC0A100A',
X'4BC0C883',X'81229341',X'8180E41F',X'1122A150',X'C813A011',
X'A2D39320',X'BA0AF800',X'98019308',X'BC0A100A',X'A83D9316',
X'782CB795',X'F9C0A735',X'5017500C',X'0C17C073',X'AE93501F',
X'930F0D15',X'68972D15',X'12E1C033',X'80DCF800',X'90BAC008',
X'BA0AAB74',X'A2739341',X'82E1E006',X'5826EFF4',X'50085826',
X'32A82768',X'C014AEF4',X'9012ABF2',X'5826F177',X'F168FC00',
X'91972C37',X'C1A83C37',X'61770835',X'E40C6908',X'DFEC2173',
X'58260CF5',X'501F9341',X'82E1E018',X'5826F177',X'AEB49197',
X'58262C37',X'C1DAFC00',X'501F9341',X'82E1E419',X'6077A2B4',
X'F573F9C0',X'C21481B4',X'C1F4C9D4',X'82E10835',X'0C06C01F',
X'B3B7B01D',X'A15DA17D',X'A1B04298',X'A3144D81',X'10050905',
X'8180DEF3',X'200CEB6C',X'E00CF168',X'DDE321C8',X'486829E8',
X'2D4C632C',X'0C2C7B8C',X'0C2C70CC',X'0C0DC00E',X'4D00117D',
X'0C4C70AC',X'4920F56E',X'117D0C4C',X'70AC0C25',X'70C88180',
X'0C2C708C',X'48408170',X'0C2C70AC',X'0C257AC8',X'814B4840',
X'0C2C790C',X'920B817D',X'640F0815',X'F575117D',X'09150C1F',
X'C006920B',X'817D5C26',X'5004EBA4',X'E004920B',X'817D5C26',
X'9002ABE2',X'920B817D',X'5C26500D',X'EBADE01F',X'93478180',
X'E00D920B',X'81315406',X'500C49C0',X'C00C49E0',X'81314B20',
X'920B817D',X'4B00C0E3',X'817A6E2F',X'08104716',X'117D5E2F',
X'50108178',X'4840A500',X'11854840',X'9205A120',X'A1E0A2E4',
X'0C07C101',X'DDE321C0',X'4BE0C053',X'A011A3E9',X'A6D31005',
X'48409205',X'A2E4B160',X'A1E00C0B',X'C0C083E2',X'EB532418',
X'C01F541F',X'501DEBDD',X'42229801',X'C0FD9802',X'E00CA8EC',
X'DDF36A8C',X'EF5D200C',X'034C0CB5',X'732C28B5',X'EB5D2418',
X'C01F541F',X'501DC8FD',X'980126D3',X'119C0855',X'C9F48287',
X'C9D482B9',X'919782E1',X'0835F16C',X'DCFD21CC',X'C1FD81D7',
X'C23482E1',X'292CB67A',X'F9A0F17B',X'0C2C612C',X'FC006ACC',
X'498842A2',X'A21A4D8F',X'11D1498D',X'09B5A354',X'A233BC0A',
X'100A82E1',X'0855282C',X'CA3481E3',X'2CAC628C',X'2C2C62CC',
X'2C6C630C',X'FC00634C',X'C0DD81EA',X'A01FA03F',X'B3F70D75',
X'11FE0835',X'EB5D075A',X'C00CC7FD',X'706CC2B4',X'82E12419',
X'C00C582C',X'0C555017',X'500CA774',X'501F9341',X'82E1E41F',
X'60F74284',X'4983A754',X'10112895',X'2D1512E1',X'EA15E00C',
X'DCF5686C',X'E0159801',X'2887C007',X'98020887',X'9801B795',
X'F9C08217',X'DE5221D5',X'AB55A375',X'A315A335',X'906282F6',
X'82E3C053',X'A0110C13',X'C1D0A190',X'BA099801',X'B715F9C0',
X'AA33CA5A',X'A2F3CB54',X'8252CB14',X'8238C334',X'823FC2D3',
X'8232A633',X'10050855',X'AB34C29A',X'82F082F6',X'82F00835',
X'AB149242',X'82D92A35',X'ADB011B4',X'0835A735',X'12F6EA3B',
X'E01BF56C',X'689BC09D',X'AA9ADB7A',X'F55DC16C',X'DC6C216C',
X'C61A686C',X'CAF49801',X'9802C87D',X'921CAB54',X'924282D9',
X'C09D825F',X'C23AC19D',X'82ABA1D4',X'A69310C2',X'C0BD82D7',
X'C23AC19D',X'8266A693',X'10C2EB53',X'E00CCA3A',X'082C0C2C',
X'C1D3D9F3',X'1C2C200C',X'034C2D35',X'708C2CB5',X'11B982E1',
X'C87D921C',X'AA53C19D',X'827DA1F4',X'A69310C2',X'DDF3200C',
X'EB4C0753',X'C00C2DD5',X'708C0CB5',X'12E10833',X'919782E1',
X'0895C0DD',X'8293A01F',X'A03FB3F7',X'498B0955',X'A7541011',
X'EB5D075A',X'C00CC7FD',X'706CC2B4',X'82E12419',X'C00C582C',
X'0C555017',X'500CA774',X'501F9341',X'82E1E41F',X'60B7498B',
X'A7541011',X'2D1512E1',X'EB53E00C',X'CA3A082C',X'0C2CC1D3',
X'D9F31C2C',X'200C034C',X'2D35786C',X'82E128B5',X'919782E1',
X'C87D921C',X'C09D82CE',X'C19D82C4',X'A1D4A693',X'10C2DDF3',
X'200CEB4C',X'0753C00C',X'0CB5706C',X'82E10C33',X'12B809D5',
X'C0BD82D7',X'C19D82D5',X'A69310C2',X'AE3A1266',X'A51012DB',
X'A130A2F4',X'EA3BE411',X'F9000C1A',X'C1B082E8',X'498D9205',
X'CA138213',X'A2F4A130',X'A1F00C13',X'C1D0C053',X'A011AA73',
X'BA09A6D3',X'1011B170',X'0C1AC0F0',X'DCFA21B0',X'82EA9205',
X'A170A5F0',X'12DAAAF3',X'CAF48022',X'F17DF17F',X'B3D74284',
X'A33483D8',X'8005B715',X'F9C00C75',X'12F64BC0',X'740E5008',
X'C8089802',X'4BE08801',X'F08C640E',X'080C540E',X'500C4BE0',
X'98014043',X'B7AC131D',X'F3ACDCAC',X'200C090C',X'E80E200C',
X'98019316',X'084C540C',X'50061C4E',X'68669308',X'98016C2C',
X'0810640C',X'08114067',X'E00C540C',X'5006B806',X'640C0806',
X'930FB809',X'AAD3F170',X'C8114880',X'F1719803',X'229F283F',
X'A81FD83F',X'09159802',X'EA37E017',X'C43D62B7',X'4137413A',
X'EFB4787F',X'EBA40835',X'07BFC008',X'EFBF60A8',X'E4087088',
X'9801E008',X'0835A808',X'DFC82008',X'EE92787F',X'EA822008',
X'5C28500C',X'5008EE3F',X'900BC374',X'8368DEEC',X'787DDB6C',
X'E008EB74',X'0368B708',X'78689801',X'08353828',X'F0CCAA94',
X'C82CA294',X'EA3F2637',X'C0082828',X'C9A89801',X'EA28022C',
X'AFEB786C',X'98010835',X'C06B8385',X'C02B9801',X'A3EB540B',
X'900B837D',X'0835CA94',X'8395C02B',X'9801EA3F',X'C83DEA28',
X'E01FB34C',X'382CF1EB',X'D83F0875',X'328B9802',X'08354063',
X'2855C02B',X'98010875',X'E81FC83D',X'E008B2AC',X'382CF07F',
X'EA37241F',X'C00CABEB',X'F17EDD28',X'21DEEA8B',X'201E282C',
X'F168DD2C',X'21C8D928',X'2017B108',X'E8080017',X'B2A8E808',
X'000CFC00',X'716C583E',X'C03D285E',X'040C9016',X'C0369801',
X'FC007ACC',X'541E9008',X'C0289801',X'C81783CA',X'085EC83D',
X'289E200C',X'B12BE80B',X'0017EA88',X'E008A048',X'D82CC03D',
X'D83F32C8',X'08359802',X'A273F57A',X'F8604D8A',X'1005C334',
X'80058059',X'CAD4A274',X'8005AC53',X'118A0000',X'00000000'(9),
X'0000F2B2',X'B80AA213',X'498D9800',X'0C030005',X'F621BEA3'
LIST
!*
!* COMMUNICATIONS RECORD FORMAT - EXTANT FROM CHOPSUPE 20L ONWARDS *
RECORDFORMAT COMF(INTEGER OCPTYPE,IPLDEV,SBLKS,SEPGS,NDISCS, C
DLVNADDR,GPCTABSIZE,GPCA,SFCTABSIZE,SFCA,SFCK,DIRSITE, C
DCODEDA,SUPLVN,TOJDAY,DATE0,DATE1,DATE2, C
TIME0,TIME1,TIME2,EPAGESIZE,USERS,CATTAD,SERVAAD, C
BYTEINTEGER NSACS,RESV1,SACPORT1,SACPORT0, C
NOCPS,RESV2,OCPPORT1,OCPPORT0, C
INTEGER ITINT,CONTYPEA,GPCCONFA,FPCCONFA,SFCCONFA, C
BLKADDR,RATION,SMACS,TRANS,LONGINTEGER KMON, C
INTEGER DITADDR,SMACPOS,SUPVSN,PSTVA,SECSFRMN,SECSTOCD, C
SYNC1DEST,SYNC2DEST,ASYNCDEST,MAXPROCS,INSPERSEC,ELAPHEAD, C
COMMSRECA,STOREAAD,PROCAAD,SFCCTAD,DRUMTAD,TSLICE,FEPS, C
MAXCBT,SP1,SP2,SP3,SP4,SP5,SP6,SP7, C
LSTL,LSTB,PSTL,PSTB,HKEYS,HOOT,SIM,CLKX,CLKY,CLKZ, C
HBIT,SLAVEOFF,INHSSR,SDR1,SDR2,SDR3, C
SDR4,SESR,HOFFBIT,S2,S3,S4,END)
RECORDFORMAT ALEF(INTEGER S, A)
RECORDFORMAT CA0F(INTEGER MARK, PAW, PIW0, PIW1, CSAW0, C
CSAW1, CRESP0, CRESP1)
RECORDFORMAT CASEF(INTEGER SAW0, SAW1, RESP0, RESP1)
RECORDFORMAT CAF(INTEGER MARK,PAW,PIW0,PIW1,CSAW0,CSAW1,CRESP0,CRESP1, C
RECORD (CASEF)ARRAY S ENTRY(0:14))
RECORDFORMAT DEVICE ENTRY F(INTEGER X1, GPTSM, PROP A, C
SECS SINCE, CA A, G RCB A, LB A, AL A, X2, RESP0, C
RESP1, SENSE1, SENSE2, SENSE3, SENSE4, X3, X4, IDENT C
, X5, MNEMONIC, DEVICE ENTRY S, PAW, U SAW 0, C
U RCB A, SENSE DATA A, LOG MASK, TR TABLE A, UA S, C
UA A, TIMEOUT, PROPS0, PROPS1)
RECORDFORMAT GPCT F(BYTEINTEGER FLAGS, DEVTYPE, BUSY, LINK, C
INTEGER X4, RESPONSE DEST, DEVICE ENTRY A, C STATUS, C
PTSM, MNEMONIC, C
BYTEINTEGER MECHINDEX, PROPS03, SERVRT, STATE)
!*
RECORDFORMAT INIF(INTEGER PSTS, PSTA, CAA, SOE)
!*
RECORDFORMAT RCB F(INTEGER LIM FLAGS, LSTA, LB S, LB A, AL S, C
AL A, INIT WORD, X1)
OWNBYTEINTEGERARRAYFORMAT BIFT(0:383)
OWNINTEGERARRAYFORMAT IFT(0:1023)
!*
!* DECLARATIONS FOR CDS DEV ON
!*
OWNINTEGER XSTRM = -1, XPT = -1
OWNINTEGER XINIT, XA, XSLOT, XMNEMONIC, XDEVTYPE, XGPC, XCAA, C
XGPTSM, XPTS, XSTATE, XSRCE
OWNINTEGER XCART, XSTYLE, XLEN, XS
OWNINTEGERARRAY X(0:117)
OWNRECORD (RCBF)NAME XRCB
OWNRECORD (CAF)NAME XCA
OWNRECORD (CASEF)NAME XSENT
OWNRECORD (ALEF)ARRAYFORMAT ALEFF(0:3)
OWNRECORD (ALEF)ARRAYNAME XALE
OWNINTEGERARRAY XLBE(0:7) = C
X'00F10900',X'04F10800',X'04F00E00',X'00F00402',
X'80F02504',X'80F00106',X'82F00500',X'80F00106'
!*
!* DECLARATIONS FOR CDM
!*
CONSTBYTEINTEGER ZX=11
CONSTINTEGER CDMDEVLIMIT=6
CONSTINTEGERARRAY CDMDEV(0:CDMDEVLIMIT)=C
M'FE',M'LP',M'CR',M'CP',M'PR',M'PT',M'SU'
CONSTBYTEINTEGERARRAY CDMDEVTYPE(0:CDMDEVLIMIT)=14,6,4,3,2,1,13
CONSTINTEGERARRAY CDMDEVTIMEOUT(0:CDMDEVLIMIT)=C
X'01FF0003',60,300,600,60,60,10; ! top of FEP word is logmask
!*
!*
!*
!*
!*
!*
! NOTES ON GPC PROGRAM
!*
!*
!*
!*
!*
!* 1. SOME CALLING SEQUENCES.
!* PAW NOT CLEARED/GPC DUMP/GPC INIT
!* CONNECT STREAMS/PON GPC INT
!* HENCE ROUTINES ARE DECLARED IN REVERSE ORDER
!*
!*
!* 2. SLOTS.
!* A SLOT CAN BE IN ONE OF 6 STATES
!* DISCONNECTED
!* NOT ALLOCATED
!* READY
!* REQUEST FIRED
!* SENSE FIRED
!* QUEUED
!*
!*
!* 3. MAG TAPES.
!* THEORETICALLY, A MT STREAM CAN HAVE UP TO 8 DRIVES (OR
!* MECHANISMS). FOR EACH MT STREAM THEREFORE, 8 BYTES ARE
!* ALLOCATED IN THE ARRAY MECHSLOTS. EACH BYTE CONTAINS A
!* SLOT NUMBER. THE MECHINDEX FIELD IN A SLOT POINTS TO
!* THE FIRST OF THESE 8 BYTES. CONSEQUENTLY, GIVEN PTSM,
!* CAN USE PTS_TO_SLOT TO GET SOME SLOT ON STREAM, PICK
!* UP MECHINDEX, THEN ADD ON M AND ACCESS MECHSLOTS TO GET
!* THE REQUIRED SLOT NUMBER.
!*
ROUTINE MSG(STRING (120) TXT)
PRINTSTRING(TXT."
")
END ; ! OF MSG
!*
ROUTINE REPLY(INTEGER SRCE, STRING (63) TXT)
RECORD (PARMF) P
P=0
P_DEST=SRCE
IF LENGTH(TXT)>23 THEN LENGTH(TXT)=23
STRING(ADDR(P_P1))=TXT
PON(P)
END ; ! OF REPLY
!*
ROUTINE SLOTS
MSG("GPC's tables:-")
DUMPTABLE(0,ADDR(TABLE(0)),TABLE(0)<<2+4)
END ; ! OF SLOTS
!*
ROUTINE PON GPC INT(INTEGER PT)
RECORD (PARMF) P
P_SRCE=0
P_DEST=GPC DEST!3; ! INTERRUPT ENTRY
P_P1=PT
PON(P)
END ; ! OF PON GPC INT
!*
ROUTINE GET CA(INTEGER CAA)
*LXN_CAA
*INCT_(XNB +0)
*JCC_8, <GOT>
SEMALOOP(INTEGER(CAA),2)
GOT:
END ; ! OF GET CA
!*
ROUTINE SEND CH FLAG(INTEGER PT)
INTEGER BREG
BREG=TRUNKADDR!(PT<<16)
*LB_BREG
*LSS_1
*ST_(0+B )
END ; ! OF SEND CH FLAG
!*
!*
! THIS FUNCTION INITIALISES THE GPC BY
! CLEARING IT
! LOADING THE MICROPROGRAM
! INITIALISING THE CONTROLLER AND COMMUNICATION AREA
! PARAMETERS
! CAA COMMUNICATION AREA ADDR
! PT FOR THIS GPC
! CHOPSUPE =1 IF CALLED FROM GROPE ELSE 0
! IF 1 THEN
! SLAVES NOT SWITCHED OFF/ON
! RESPONSES
! 0 = SUCCESS
! 1 << 24 ! CRESP0 MICROPROGRAM LOAD FAILS
! 2 << 24 ! CRESP0 INITIALISE FAILED, RESPONSE FROM OLD CA
! 3 << 24 ! CRESP0 DITTO, RESPONSE FROM NEW COMMS AREA
EXTERNALINTEGERFN GPC INIT(INTEGER CAA, PT, CHOPSUPE)
INTEGER BREG
INTEGER COUNT
INTEGER J
INTEGER PSTA
INTEGER PSTS
CONSTRECORD (CA0F)NAME CA0=RA0AD
RECORD (CAF)NAME CA
RECORD (INI F) INI
! CLEAR GPC
BREG=TRUNKADDR!(PT<<16)
*LSS_2
*LB_BREG
*ST_(0+B )
WAIT(50); ! MILLISECONDS
! SLAVES OFF IF NOT CALLED FROM GROPE
IF CHOPSUPE=0 THEN SLAVES ON OFF(0)
! LOAD GPC MICROPROGRAM THE ORIGINAL BOOTSTRAP DID
! CA0_CSAW0 = X1000, ALTHOUGH GPC TECHNICAL DESCR
! 1112732 SHEET 13 SAYS ONLY CSAW1 RELEVANT
CA0=0
CA0_PAW=LOAD MICROPROGRAM
CA0_CSAW1=REALISE(ADDR(GPCMPROG(0)))
CA0_MARK=-1
SEND CH FLAG(PT)
COUNT=0
COUNT=COUNT+1 UNTIL (CA0_CRESP0#0 AND CA0_MARK=-1) C
OR COUNT>300000
! IF NORMAL_REQUEST_TERMINATION BIT NOT SET THEN LOAD FAILED
IF CA0_CRESP0&NORMAL TERMINATION=0 C
THEN RESULT =(1<<24)!CA0_CRESP0
WAIT(50); ! MILLISECONDS
! INITIALISE GPC GIVING PST REAL ADDR AND LIMIT
CA0=0
CA0_PAW=DO CONTROLLER REQUEST
CA0_CSAW0=INIT CONTROLLER
CA0_CSAW1=REALISE(ADDR(INI))
GET PSTB(PSTS,PSTA);
INI_PSTS=PSTS
INI_PSTA=PSTA
INI_CAA=CAA
INI_SOE=0
! INITIALISE THE NEW COMMS AREA
CA==RECORD(CAA)
CA=0
CA_MARK=-1
! FREE COMMS AREA
CA0_MARK=-1
SEND CH FLAG(PT)
COUNT=0
COUNT=COUNT+1 UNTIL (CA_CRESP0#0 AND CA_MARK=-1) C
OR COUNT>900000
! IF NOT CALLED FROM GROPE
IF CHOPSUPE=0 THEN SLAVES ON OFF(-1);! SLAVES BACK ON
! LOOK FOR NORM TERM BIT
IF CA_CRESP0&NORMAL TERMINATION=0 START
IF MULTIOCP=YES START ; RESERVE LOG
FINISH
MSG("CA0")
DUMP TABLE(2,RA0AD,32)
MSG("CA")
DUMP TABLE(3,CAA,272)
MSG("INI")
DUMP TABLE(4,ADDR(INI),16)
IF MULTIOCP=YES START ; RELEASE LOG
FINISH
IF CA_CRESP0=0 THEN RESULT =(2<<24)!CA0_CRESP0
RESULT =(3<<24)!CA_CRESP0
FINISH
CA_CRESP0=0
CA_MARK=-1
RESULT =0
END ; ! OF GPC INIT
!*
!*
! DISCONNECTS THEN, IF CONNECT=1, CONNECTS ONE OR ALL
! STREAMS ON A GPC. ABNORMAL TERMINATIONS ARE GIVEN FOR ALL
! RELEVANT STREAMS WHICH ARE FOUND TO BE BUSY.
! PARAMETERS
! PT GPC
! CAA COMMUNICATIONS AREA ADDRESS
! STREAM IF < 0 ALL STREAMS ELSE SPECIFIED STREAM
! CONNECT =1 RECONNECTS ELSE ONLY DISCONNECTS
! TIMEOUT =1 FOR SPECIAL ABTERM OF SPECIFIED STREAM
! RESPONSES
! VARIOUS MESSAGES TO SYSTEM LOG
ROUTINE CONNECT STREAMS(INTEGER PT, CAA, STREAM, CONNECT, C
TIMEOUT)
INTEGER COUNT
INTEGER FAILS
INTEGER HI
INTEGER J
INTEGER LO
INTEGER PAW FAILS
INTEGER STRM
OWNINTEGER DUMMY WORD
OWNRECORD (ALEF) ALE
OWNRECORD (RCBF) RCB
RECORD (CAF)NAME CA
RECORD (GPCTF)NAME GPCT
RECORD (CASEF)NAME SENT
STRING (15) TXT
OWNINTEGER DISCONNECT LBE=X'00F10900'
OWNINTEGER CONNECT LBE=X'00F10800'
! MESSAGE
WK="GPC connect streams ".HTOS(PT,2)
UNLESS STREAM<0 THEN WK=WK.HTOS(STREAM,1)
UNLESS CONNECT=1 THEN WK=WK." dis"
MSG(WK)
! CONSTRUCT RCB
ALE_S=4
ALE_A=ADDR(DUMMY WORD)
RCB_LIM FLAGS=PRIV ONLY
RCB_LBS=4
RCB_LBA=ADDR(DISCONNECT LBE)
RCB_ALS=8
RCB_ALA=ADDR(ALE)
CA==RECORD(CAA)
FAILS=0
PAW FAILS=0
SLAVES ON OFF(0); ! SLAVES OFF
IF STREAM<0 THEN LO=0 AND HI=14 C
ELSE LO=STREAM AND HI=STREAM
! FIRST DISCONNECT STREAMS
TXT="disconnect"
*JLK_ <FOR EACH STREAM>
! THEN RECONNECT IF REQUIRED
IF CONNECT=1 START
WAIT(10)
RCB_LBA=ADDR(CONNECT LBE)
TXT="connect"
*JLK_ <FOR EACH STREAM>
FINISH
! SLAVES BACK ON AND PRINT COUNTS
SLAVES ON OFF(-1); ! ON
MSG("SAW fails=".HTOS(FAILS,1).", PAW fails=".HTOS( C
PAW FAILS,1))
! NOW GIVE SPECIAL ABNORMAL TERMINATION FOR EACH
! RELEVANT STREAM THAT WAS BUSY
IF TIMEOUT=1 OR STREAM<0 START
GET CA(CAA)
FOR J=0,1,LASTSLOT CYCLE
GPCT==RECORD(GPCTBASE+J*SLOTSI)
STRM=(GPCT_PTSM>>4)&15
IF (GPCT_PTSM>>8)&255=PT C
AND (GPCT_STATE=REQUEST FIRED C
OR GPCT_STATE=SENSE FIRED) C
AND (STRM=STREAM OR STREAM<0) START
! FOUND A RELEVANT STREAM THAT IS BUSY
MSG("Abn term for GPTSM ".HTOS(GPCT_PTSM,5))
! PLACE BIT IN PIW
CA_PIW0=CA_PIW0!(X'80000000'>>STRM)
! SET RESPONSE, RESP1=-1 IS AN EMAS SPECIAL
SENT==CA_S ENTRY(STRM)
SENT_RESP0=ABNORMAL TERMINATION
SENT_RESP1=-1
FINISH
REPEAT
FINISH
CA_MARK=-1
PON GPC INT(PT)
WAIT(100); ! MILLISECONDS
RETURN
!*
! PSEUDO ROUTINE
FOR EACH STREAM:
FOR J=LO,1,HI CYCLE
SENT==CA_S ENTRY(J)
GET CA(CAA)
CA_PAW=DO STREAM REQUEST!J
SENT=0
SENT_SAW0=X'30000020'; ! SAW FLAGS + RCB BOUND
SENT_SAW1=ADDR(RCB)
CA_MARK=-1
SEND CH FLAG(PT)
COUNT=0
COUNT=COUNT+1 UNTIL SENT_RESP0#0 OR COUNT>100000
IF SENT_RESP0&NORMAL TERMINATION=0 START
MSG(TXT." STRM".HTOS(J,1)." RESP0=".HTOS(SENT_ C
RESP0,8))
FAILS=FAILS+1
FINISH
SENT_RESP0=0
CA_PIW0=CA_PIW0&(¬(X'80000000'>>J));! IF IN DOUBT CLEAR BIT!
IF CA_PAW#0 THEN PAWFAILS=PAW FAILS+1
REPEAT
*J_TOS
!* END OF PSEUDO ROUTINE 'FOR EACH STREAM'
END ; ! OF CONNECT STREAMS
!*
! THIS ROUTINE IS INVOKED BY 'PAW NOT CLEARED'. IT
! CALLS 'CONTROLLER DUMP' TO PRODUCE THE DUMP, THEN
! RE-INITS THE GPC. IF CALLED MORE THAN 10 TIMES,
! IT SIMPLY RETURNS.
ROUTINE GPC DUMP(INTEGER PT)
INTEGER CAA
INTEGER GPCNO
INTEGER RES
OWNINTEGER TIMES=0
IF TIMES>10 THEN RETURN
TIMES=TIMES+1
CONTROLLER DUMP(3,PT)
GPCNO=PT TO GPC(PT-LOPT)
CAA=CAAS(GPCNO)
RES=GPC INIT(CAA,PT,0)
MSG("GPC init res=".HTOS(RES,8))
CONNECT STREAMS(PT,CAA,-1,1,0)
END ; ! OF GPC DUMP
!*
!*
! CALLED WHEN PAW OR SAW FOUND NON ZERO WHEN
! A CHANNEL FLAG IS ABOUT TO BE ISSUED. IF
! STREAM < 0, SAW IS NOT RELEVANT.
ROUTINE PAW NOT CLEARED(INTEGER PT, STREAM, PAW)
INTEGER CAA
INTEGER GPCNO
INTEGER SAW
RECORD (CAF)NAME CA
RECORD (CASEF)NAME SENT
! SET UP POINTERS
GPCNO=PT TO GPC(PT-LOPT)
CAA=CAAS(GPCNO)
CA==RECORD(CAA)
! SLAVES OFF
SLAVES ON OFF(0)
IF CA_PAW#0 THEN WAIT(100)
IF CA_PAW=0 THEN SLAVES ON OFF(-1) AND RETURN
! OK NOW
SEND CH FLAG(PT); ! RE-FIRE I/O
WAIT(100)
! SLAVES BACK ON
SLAVES ON OFF(-1)
MSG("GPC PAW not cleared PT=".HTOS(PT,2).",PAW=".HTOS( C
PAW,8))
SAW=0
UNLESS STREAM<0 START
SENT==CA_S ENTRY(STREAM)
SAW=SENT_SAW0
FINISH
IF SAW#0 START
MSG("SAW not cleared")
FINISH
UNLESS CA_PAW=0 AND SAW=0 THEN GPC DUMP(PT)
MSG("end of PAW not cleared")
END ; ! OF PAW NOT CLEARED
!*
!*
! IF CONTROLLER = 0, ISSUES 'READ STREAM DATA'
! 1, 'READ STREAMS CONTROLLER STATUS'
! 2, 'READ CONTROL STREAM STATUS'
INTEGERFN READ STRM DATA(INTEGER PT, STREAM, CONTROLLER)
CONSTSTRING (24)ARRAY HEADER(0:2)="stream data", C
"stream controller status", C
"control stream status"
INTEGER CAA
INTEGER COMMAND
INTEGER COUNT
INTEGER GPCNO
INTEGER LEN
INTEGER SAWFLAGS
OWNINTEGERARRAY STREAM DATA(0:63)
RECORD (CAF)NAME CA
IF CONTROLLER=0 START
LEN=64
COMMAND=READ STREAM DATA
FINISH ELSE START
IF CONTROLLER=1 START
LEN=4
COMMAND=READ STREAMS CONTROLLER STATUS
FINISH ELSE START
LEN=64
COMMAND=READ CONTROL STREAM STATUS
FINISH
FINISH
GPCNO=PT TO GPC(PT-LOPT)
CAA=CAAS(GPCNO)
CA==RECORD(CAA)
IF CA_PAW#0 START
PAW NOT CLEARED(PT,-1,CA_PAW)
RESULT =0
FINISH
! SLAVES OFF
SLAVES ON OFF(0)
GET CA(CAA)
CA_CRESP0=0
SAWFLAGS=3; ! CLEAR ABN & INHIBIT TERM INT
CA_PAW=DO CONTROLLER REQUEST
CA_CSAW0=SAWFLAGS<<28!COMMAND<<24!STREAM<<16!LEN
CA_CSAW1=ADDR(STREAM DATA(0))
CA_MARK=-1
SEND CH FLAG(PT)
! LOOP AWAITING RESPONSE
COUNT=0
COUNT=COUNT+1 UNTIL CA_CRESP0#0 OR COUNT>100000
! SLAVES BACK ON
SLAVES ON OFF(-1)
IF MULTIOCP=YES START ; RESERVE LOG
FINISH
PRINTSTRING("GPC ".HEADER(CONTROLLER)." pts=".HTOS(PT<<4! C
STREAM,3))
DUMP TABLE(-1,ADDR(STREAM DATA(0)),LEN)
MSG("CRESP0=".HTOS(CA_CRESP0,8))
IF MULTIOCP=YES START ; RELEASE LOG
FINISH
! RESULT USEFUL ONLY IF CONTROLLER # 0
RESULT =STREAM DATA(0)
END ; ! OF READ STRM DATA
!*
!*
INTEGERFN FIND BYTE(INTEGER BYTE, ADDR, LEN)
INTEGER I
FOR I=0,1,LEN-1 CYCLE
IF BYTE=BYTE INTEGER(ADDR+I) THEN RESULT =I
REPEAT
RESULT =-1
END ; ! OF FIND BYTE
!*
STRINGFN MNEMO(INTEGER MNEMONIC)
INTEGER I, J
I=MNEMONIC
J=0
IF BYTE INTEGER(ADDR(I)+1)=0 THEN J=1
BYTE INTEGER(ADDR(I)+J)=3-J
RESULT =STRING(ADDR(I)+J)
END ; ! OF MNEMO
!*
INTEGERFN TRANS MNEMO(STRINGNAME S)
INTEGER M, A, I, J
M=0
A=ADDR(S)
IF CHARNO(S,1)='X' START
S->("X").S
FOR I=1,1,BYTEINTEGER(A) CYCLE
J=BYTE INTEGER(A+I)
UNLESS '0'<=J<='9' OR 'A'<=J<='F' C
THEN RESULT =0
M=M<<4+(9*J>>6)+(J&15)
REPEAT
FINISH ELSE START
IF BYTE INTEGER(A)=3 START
FOR I=1,1,3 CYCLE
BYTE INTEGER(ADDR(M)+I)=BYTE INTEGER(A+I)
REPEAT
FINISH
FINISH
RESULT =M
END ; ! OF TRANS MNEMO
!*
INTEGERFN STATE CHECK(INTEGER SRCE, MNEM, STATE)
INTEGER J, A
RECORD (GPCT F)NAME G
IF MNEM>>16=M'M' START
! TAPE CLUSTER, INSIST THAT ALL DECKS
! IN CLUSTER ARE 'NOT ALLOC'
UNLESS MNEM&255=M'0' START
REPLY(SRCE,"GPC: must be MN0")
RESULT =1
FINISH
A=GPCT BASE
FOR J=0,1,LASTSLOT CYCLE
G==RECORD(A)
IF G_MNEMONIC&X'FFFF30'=MNEM START
UNLESS G_STATE=NOT ALLOCATED START
REPLY(SRCE,"GPC: ".MNEMO(G_MNEMONIC). C
" STATE ?")
RESULT =1
FINISH
FINISH
A=A+SLOTSI
REPEAT
RESULT =0
FINISH
RESULT =0 IF STATE=NOT ALLOCATED
RESULT =0 IF STATE=READY AND MNEM&X'FFFF30'=M'OP0'
! SPECIAL DISPENSATION FOR OPERS
REPLY(SRCE,"GPC: ".MNEMO(MNEM)." state ?")
RESULT =1
END ; ! OF STATE CHECK
!*
STRINGFN MNS(RECORD (DEVICE ENTRY F)NAME D)
INTEGER I
I=D_MNEMONIC
BYTEINTEGER(ADDR(I))=3
RESULT =STRING(ADDR(I))
END ; ! MNS
!*
!* ! MAIN GPC ROUTINE
!*
EXTERNALROUTINE GDC(RECORD (PARMF)NAME INP)
INTEGER DACT, FLAG, CAA, SLOT, PAWFN, SAWFLAGS, URCB A, USAW0
INTEGER LAST, MECH, STRM, GPCNO, BREG, PIW0
INTEGER J, PT, RESP0, RESP1, OSNO, PREVIOUS PT
INTEGER SRCE, CALLED
INTEGER I
INTEGER INTERRUPT ANALYSIS FLAGS
INTEGER FLAGS
INTEGER GPTSM
INTEGER MNEMONIC
INTEGER MNEMONIC1, MNEMONIC2
INTEGER P3
INTEGER SEMA
INTEGER SLOT A
INTEGER BUSY
INTEGER STATE
INTEGER GMON
INTEGER ACT
STRING (15) MNEMOS
RECORD (PARMF) P
RECORD (PARMF) Q
!*
OWNINTEGER SETUP=0
!*
BYTEINTEGERNAME QHD
BYTEINTEGERARRAYNAME REP, TRTAB
!*
SWITCH G COMMAND(1:LIMIT)
SWITCH GS(1:12)
SWITCH CDS(0:7)
!*
CONSTRECORD (COMF)NAME COM=X'80000000'!48<<18
RECORD (DEVICE ENTRY F)NAME D
RECORD (CAF)NAME CA
RECORD (CASEF)NAME SENT
RECORD (GPCT F)NAME GPCT,GE
!*
P=INP
IF KMONNING=YES START
GMON<-(KMON>>GPC SNO)&1
PKMONREC("GPC( in):",P) IF GMON=YES
FINISH
IF SETUP=0 START
! IF NOT YET INITIALISED, IGNORE EVERYTHING
! EXCEPT THE INITIALISATION CALL
RETURN UNLESS P_DEST&X'FFFF'=2
SETUP=1
J=P_P1; ! ADDRESS OF TABLE CONTAINING TABLES
TABLE==ARRAY(J,IFT)
TABLE(42)=P_P2 UNLESS P_P2=0; ! ADDR OF PROCESS LIST PICTURE
STRM SEMAPHORE==ARRAY(J+TABLE(40)<<2,IFT)
GPCTBASE=J+TABLE(1)<<2
LASTSLOT=TABLE(2)
NO OF GPCS=TABLE(3)
STRMQBASE=J+TABLE(4)<<2
PTSBASE=J+TABLE(5)<<2
PTGPCBASE=J+TABLE(6)<<2
MECHPT=J+TABLE(7)<<2
CAASBASE=ADDR(TABLE(8))
LOPT=TABLE(16)
HIPT=TABLE(16+NO OF GPCS-1)
PTS TO SLOT==ARRAY(PTSBASE,BIFT)
PT TO GPC==ARRAY(PTGPCBASE,BIFT)
STRMQ==ARRAY(STRMQBASE,BIFT)
CAAS==ARRAY(CAASBASE,IFT)
MECHSLOTS==ARRAY(MECHPT,BIFT)
GPCT==RECORD(GPCTBASE)
FOR J=0,1,15 CYCLE
REPERTOIRE A(J)=ADDR(LP96REP(0))
REPERTOIRE S(J)=96
REPEAT
REPERTOIRE A(3)=ADDR(LP384REP(0))
REPERTOIRE S(2)=48
REPERTOIRE S(3)=384
REPERTOIRE S(4)=64
! RE-INITIALISE SLOTS
FOR J=0,1,LASTSLOT CYCLE
GPCT==RECORD(GPCTBASE+J*SLOTSI)
GPCT_FLAGS=0
GPCT_LINK=ENDLIST
IF GPCT_DEVTYPE=ZX THEN GPCT_STATE=DISCONNECTED C
ELSE GPCT_STATE=NOT ALLOCATED
GPCT_BUSY=0
GPCT_X4=0
GPCT_RESPONSE DEST=0
GPCT_C STATUS=0
GPCT_SERVRT=0
D==RECORD(GPCT_DEVICE ENTRY A)
D_RESP0=0
D_RESP1=0
REPEAT
! RE-INITIALISE STREAM Q HEADS
J=0
WHILE J<NO OF GPCS<<4 CYCLE ; ! NO OF GPCS*16
STRMQ(J)=X'FF'
J=J+1
REPEAT
PREVIOUS PT=0; ! to hold PTS really
FOR J=0,1,LASTSLOT CYCLE
GE==RECORD(GPCTBASE+J*SLOTSI)
IF GE_DEVTYPE=OP START
I=GE_MECHINDEX>>4; ! LOGICAL OPER NO
P=0
P_P1=GE_MNEMONIC
P_P2=X'320005'!(I<<8); ! WHERE WE WANT OPER INTERRUPTS
P_DEST=X'30000B'; ! ALLOCATE
P_SRCE=X'320002'!(I<<8); ! ALLOCATE RESPONSE TO OPER
PON(P)
FINISH ELSE IF GE_DEVTYPE=FE START
P=0
P_P1=GE_MNEMONIC
P_P2=X'390005'; ! WHERE WE WANT FE INTERRUPTS
P_DEST=X'30000B'; ! ALLOCATE
P_SRCE=X'390002'; ! ALLOCATE RESPONSE TO FE ADAPTOR
PON(P)
FINISH ELSE IF GE_DEVTYPE=MT START
! NEW TAPE INIT
! ONE CALL PER CLUSTER
! P_P1 = LOW MNEMONIC FOR STREAM
PT=(GE_PTSM>>4)&X'FFF'; ! holds PTS really
IF PREVIOUS PT#PT START
P=0
P_DEST=X'00310004'
P_SRCE=X'00300000'
P_P1=GE_MNEMONIC; ! RH char must be and should be zero
PON(P)
PREVIOUS PT=PT
FINISH
FINISH ELSE IF CSU FITTED=YES AND GE_DEVTYPE=SU START
P=0
P_DEST=CSU DEST; ! CSU initialise
P_P1=GE_MNEMONIC
PON(P)
FINISH
REPEAT
!*
MSG("...".VSN)
SLOTS
!*
P_DEST=X'A0001'; ! INTERVAL TIMER
P_SRCE=1<<31
P_P1=GPC DEST+6
P_P2=TICK INTERVAL
PON(P)
->OUT
FINISH
!*
!* ! MAIN BODY
!*
DACT=P_DEST&X'FFFF'
SRCE=P_SRCE
CALLED=SRCE>>31; ! SET #0 IF CALLED, ZERO IF PONNED
SRCE=(SRCE<<1)>>1; ! REMOVE TOP BIT
FLAG=1
IF 0<DACT<13 THEN ->GS(DACT)
->ACKNOWLEDGE
!*
! COMMAND, FORMS RECOGNISED ARE:
! QS DEV
! CDS DEV ON/OFF
! CDM mnem1 mnem2
! ?
! SET
GS(1):
IF BYTE INTEGER(ADDR(P_P1))>23 THEN RETURN ; ! RUBBISH STRING
WK=STRING(ADDR(P_P1))." * * *"
FOR J=1,1,LIMIT CYCLE
IF WK->(COMMAND(J)).WK THEN ->FOUND
REPEAT
ERR:
REPLY(SRCE,"GPC ??".STRING(ADDR(P_P1)))
RETURN
FOUND:
IF J<4 START
WK->MNEMOS.(" ").WK
MNEMONIC=TRANS MNEMO(MNEMOS)
*JLK_<FIND>
IF SLOT<0 THEN ->ERR
*JLK_<DO MAPPINGS>
FINISH
->G COMMAND(J)
! QS DEV
G COMMAND(1):
*JLK_<STATUS>
RETURN
STATUS:
REPLY(SRCE,"GPC: ".MNEMO(GPCT_MNEMONIC)." ".HTOS(GPCT_PTSM C
&X'FFFF',4)." ".STATES(GPCT_STATE&15))
*J_TOS
! CDS DEV ON/OFF
G COMMAND(2):
IF WK->("OFF ").WK START
IF STATE CHECK(SRCE,MNEMONIC,STATE)=OK START
CONNECT STREAMS(PT,CAA,STRM,0,0)
IF MNEMONIC>>16=M'M' START ; ! TAPE CLUSTER
I=GPCT BASE
FOR J=0,1,LASTSLOT CYCLE
GPCT==RECORD(I)
IF GPCT_MNEMONIC&X'FFFF30'=MNEMONIC THEN C
GPCT_STATE=STATE<<4!DISCONNECTED
I=I+SLOTSI
REPEAT
GPCT==RECORD(GPCT BASE+SLOT*SLOTSI)
FINISH ELSE GPCT_STATE=STATE<<4!DISCONNECTED
FINISH
->G COMMAND(1)
FINISH
IF WK->("ON ").WK START
IF STATE=DISCONNECTED START
->CDS ON
FINISH
->G COMMAND(1)
FINISH
->ERR
G COMMAND(3): ! CDM
MNEMONIC1=MNEMONIC
WK->MNEMOS.(" ").WK
MNEMONIC=TRANS MNEMO(MNEMOS)
MNEMONIC2=MNEMONIC
J=SLOT; ! SAVE 1ST SLOT
*JLK_<FIND>
UNLESS SLOT<0 THEN ->ERR; ! ALREADY EXISTS
GPCT==RECORD(GPCT BASE+J*SLOTSI); ! REMAP TARGET SLOT
IF MNEMONIC1>>8=M'ZX' START ; ! INTRODUCE DEVICE
I=MNEMONIC2>>8
FOR J=0,1,CDMDEVLIMIT CYCLE
IF I=CDMDEV(J) THEN ->IDEV
REPEAT
->ERR; ! INVALID FOR CDM
IDEV:
GPCT_MNEMONIC=MNEMONIC2
GPCT_DEVTYPE=CDMDEVTYPE(J)
D_MNEMONIC=MNEMONIC2
IF CDMDEVTYPE(J)=LP START
D_UA S=D_UA S-256; ! TRTAB SPACE
D_TR TABLE A=D_UA A+D_UA S
FINISH
D_TIMEOUT=CDMDEVTIMEOUT(J)&X'FFFF'
D_LOGMASK=CDMDEVTIMEOUT(J)>>16
IF CDMDEVTYPE(J)=FE THEN COM_FEPS=COM_FEPS!1<<(16+ C
MNEMONIC2&15)
! FEP MAP
FINISH ELSE START ; ! TAKE OUT DEVICE
UNLESS MNEMONIC2>>8=M'ZX' THEN ->ERR
UNLESS STATE=DISCONNECTED THEN ->ERR
I=MNEMONIC1>>8
FOR J=0,1,CDMDEVLIMIT CYCLE
IF I=CDMDEV(J) THEN ->TOUT
REPEAT
->ERR
TOUT:
IF CDMDEVTYPE(J)=FE THEN COM_FEPS=COM_FEPS&(¬(1<<(16+ C
MNEMONIC1&15)))
IF CDMDEVTYPE(J)=LP START
D_UA S=D_UA S+256; !RECOVER TRTAB SPACE
D_TR TABLE A=0
FINISH
GPCT_MNEMONIC=MNEMONIC2
GPCT_DEVTYPE=ZX
FINISH
->G COMMAND(1)
! SET
G COMMAND(5):
XPT=-1
XSTRM=-1
G COMMAND(4): ! ?
FOR SLOT=0,1,LASTSLOT CYCLE
GPCT==RECORD(GPCT BASE+SLOT*SLOTSI)
*JLK_<STATUS>
REPEAT
RETURN
!*
! ALLOCATE ** NEW VERSION 9/79 **
!*
GS(11):
MNEMONIC=P_P1
*JLK_<FIND>
UNLESS SLOT<0 START
*JLK_<DO MAPPINGS>
FLAG=2
IF STATE=NOT ALLOCATED START
FLAG=0
IF GPCT_DEV TYPE=OP START ; ! EXTRA INFORMATION FOR OPERS
OSNO=GPCT_MECHINDEX>>4; ! GET LOGICAL NO OF THIS OPER STREAM
D_X2=CAA+TABLE(OSNO+32)>>16; ! BUFFER ADDR
D_RESP0=GPCT_MECHINDEX&15; ! SCREENS
D_X1=TABLE(OSNO+32)&X'FFFF'; ! BUFFER SIZE
FINISH ELSE IF GPCT_DEV TYPE=LP THEN D_X1=GPCT_RESPONSE DEST; ! & LPs
GPCT_STATE=READY
GPCT_RESPONSE DEST=P_P2
! NOW CONSTRUCT THE REPLY
P_P2=LOID+SLOT
P_P3=ADDR(D)
P_P6=GPCT_MNEMONIC
FINISH
FINISH
->ACKNOWLEDGE
!*
GS(8):
! SPECIAL FORCED ALLOCATE CALL (NOT PON)
! FOR USE BY ENTER & MAINLP
! P_P1 = PTSM OR LP
! P_P2 = DEST (IF MAINLP)
! ON RETURN
! P_P1 = 0 SUCCESS
! 1 MNEMONIC NOT KNOWN
! 2 DISCONNECTED
! P_P2 = SNO
! P_P3 = ADDRESS OF DEVICE ENTRY
! P_P6 = MNEMONIC
MNEMONIC=P_P1
*JLK_<FIND>
UNLESS SLOT<0 START
*JLK_<DO MAPPINGS>
FLAG=2
UNLESS STATE=DISCONNECTED START
FLAG=0
GPCT_STATE=READY
GPCT_RESPONSE DEST=P_P2
P_P2=LOID+SLOT
P_P3=ADDR(D)
P_P6=GPCT_MNEMONIC
FINISH
FINISH
P_P1=FLAG
INP=P
RETURN
!*
! DE-ALLOCATE ** NEW VERSION 4/81 **
!*
GS(5):
UNLESS P_P1=M'LP' START
MNEMONIC=P_P1
*JLK_<FIND>
FLAG=2
UNLESS SLOT<0 START
*JLK_<DO MAPPINGS>
P_P3=ADDR(D)
FLAG=3!STATE<<16
IF STATE=READY START
IF SRCE>>16>63 START ; ! FROM USER PROCESS
IF 0<GPCT_RESPONSE DEST>>16<64 C
THEN FLAG=4 AND ->FALL
! PROHIBIT
FINISH
GPCT_FLAGS=0
GPCT_STATE=NOT ALLOCATED
FLAG=0
FINISH
FINISH
FINISH
FALL:
!* MSG("GPC deallocate ".MNEMO(P_P1). %C
!* " FLAG=".HTOS(FLAG,1))
->ACKNOWLEDGE
!*
! CLOCK INTERRUPT
! NO PARAMETERS
!*
GS(6):
! EACH TIME A CLOCK INTERRUPT OCCURS
! 1 FOR EACH BUSY SLOT, INCREMENT 'SECS SINCE'
! IF THIS BECOMES > TIMEOUT, ISSUE COPIOUS
! WARNINGS/DUMPS AND RECONNECT STREAM
FOR SLOT=0,1,LASTSLOT CYCLE
GE==RECORD(GPCT BASE+SLOT*SLOTSI)
GPCNO=GE_PTSM>>16
PT=(GE_PTSM>>8)&255
D==RECORD(GE_DEVICE ENTRY A)
CAA=D_CAA
CA==RECORD(CAA)
IF GE_STATE=REQUEST FIRED OR GE_STATE=SENSE FIRED C
THEN D_SECS SINCE=D_SECS SINCE+TICK INTERVAL
IF D_SECS SINCE>D_TIMEOUT START
STRM=GE_PTSM>>4&15
IF MULTI OCP=YES START
*JLK_<GET STRM SEMA>
UNLESS GE_BUSY=0 THEN INTEGER(SEMA)=-1 AND CONTINUE
GE_BUSY=TIMING OUT
INTEGER(SEMA)=-1
FINISH
WK="GPC timeout ".MNS(D)." ".HTOS(D_GPTSM,5)
MSG(WK)
J=READ STRM DATA(PT,STRM,0)
*JLK_<GET CA>
CA_PAW=3<<24!STRM; ! STOP STREAM
*JLK_<SEND CH FLAG>
WAIT(50)
CONNECT STREAMS(PT,CAA,STRM,1,1)
D_SECS SINCE=0
MSG("End of timeout")
IF MULTI OCP=YES START
*JLK_<GET STRM SEMA>
GE_BUSY=0
INTEGER(SEMA)=-1
FINISH
FINISH
REPEAT
->OUT
!*
! EXECUTE ** NEW VERSION 9/79 **
!*
GS(12):
SLOT=P_P2-LOID
! CHECK THAT SLOT IN RANGE
IF 0<=SLOT<=LASTSLOT THEN START
*JLK_<DO MAPPINGS>
P3=P_P3
P_P3=ADDR(D)
D_IDENT=P_P4
P_P6=P_P4
P_P4=0
P_P5=0
FLAG=2
! CHECK DEVICE STATE
FLAGS=GPCT_FLAGS
IF STATE=READY START
PAW FN=(P3&X'F0')<<20!STRM
U RCB A=P_P1
SAWFLAGS=P3&15
USAW0=(SAWFLAGS<<28)!RCB BOUND
! IF THIS STREAM IS IDLE, CAN ISSUE REQUEST FORTHWITH
IF MULTI OCP=YES START
*JLK_<GET STRM SEMA>
FINISH
IF QHD=ENDLIST START
IF MULTI OCP=YES START ; !OK TO RELEASE
INTEGER(SEMA)=-1
FINISH
IF CA_PAW#0 OR SENT_SAW0#0 C
THEN PAW NOT CLEARED(PT,STRM,CA_PAW)
*JLK_<GET CA>
CA_PAW=PAW FN
GPCT_LINK=ENDLIST
QHD=SLOT
SENT_SAW0=USAW0
SENT_SAW1=U RCB A
*JLK_<SEND CH FLAG>
STATE=REQUEST FIRED
FINISH ELSE START
! IF DEVICE IS NOT BUSY BUT STREAM IS, WE HAVE
! MULTI MECH STREAM. SO QUEUE THIS REQUEST
IF GPCT_DEVTYPE#MT START ; ! GASP!!
MSG("GPC about to Q non-MT dev req!!")
DUMPTABLE(79,X'80C00000',4096)
FINISH
STATE=QUEUED
LAST=QHD
UNTIL LAST=ENDLIST CYCLE
GE==RECORD(GPCT BASE+LAST*SLOTSI)
LAST=GE_LINK
REPEAT
GPCT_LINK=ENDLIST
GE_LINK=SLOT
IF MULTI OCP=YES START
INTEGER(SEMA)=-1; ! RELEASE SEMAPHORE
FINISH
FINISH
! SET GPCT_FLAGS
GPCT_STATE=STATE
! %IF P3&X'100'=0 %THEN GPCT_FLAGS=FLAGS&(¬ %C
! GET STRM DATA) %ELSE GPCT_FLAGS=FLAGS!GET STRM DATA
IF P3&X'100'=0 THEN GPCT_FLAGS=0 ELSE C
GPCT_FLAGS=GET STRM DATA; !** ONLY 1 BIT USED SO SIMPLIFIED VSN OK
! FINALLY, SET FIELDS IN DEVICE ENTRY
D_USAW0=USAW0
D_U RCB A=U RCB A
D_PAW=PAW FN
D_RESP1=0; ! TO CANCEL POSSIBLE TIMEOUT INDICATION
D_SECS SINCE=0
CALLED=1
! FORCES RETURN RATHER THAN PON
FLAG=0
FINISH
FINISH
->ACKNOWLEDGE
!*
! INTERRUPT
! P1 = PT
!*
GS(3):
PT=P_P1
GPCNO=PT TO GPC(PT-LOPT)
CAA=CAAS(GPCNO)
CA==RECORD(CAA)
! PICK UP AND CLEAR PIW
*JLK_<GET CA>
PIW0=CA_PIW0
CA_PIW0=0
CA_MARK=-1
MORE INTS:
! DEAL WITH EACH BIT IN PIW0
*LSS_PIW0
! JUMP OUT IF 'NO BITS SET'
*JAT_4, <OUT>
*SHZ_STRM
PIW0=PIW0!!X'80000000'>>STRM
SENT==CA_S ENTRY(STRM)
*JLK_<GET CA>
RESP0=SENT_RESP0
INTERRUPT ANALYSIS FLAGS=(RESP0>>20)&15
RESP1=SENT_RESP1
SENT_RESP0=0
SENT_RESP1=0
CA_MARK=-1
! IGNORE TOTALLY SPURIOUS INTERRUPTS
IF RESP0=0 THEN SLOT=ENDLIST AND ->SPURIOUS INTERRUPT
! XSTRM AND XPT ARE INITIALISED TO -1, THEY
! ASSUME OTHER VALUES DURING CDS ON
IF STRM=XSTRM AND PT=XPT START
->MORE INTS IF INTERRUPT ANALYSIS FLAGS=1; ! THROW AWAY ATTENTION INTERRUPTS
->CDS(XSTATE)
FINISH
IF INTERRUPT ANALYSIS FLAGS=1 START
! MECH APPEARS IN RESPONSE ONLY FOR ATTENTION INTERRUPTS
! HENCE THE TWO DIFFERENT WAYS OF COMPUTING SLOT
MECH=(RESP0>>24)&15
SLOT=PTS TO SLOT(((PT-LOPT)<<4)!STRM)
UNLESS SLOT=ENDLIST START
GPCT==RECORD(GPCT BASE+SLOT*SLOTSI)
IF GPCT_DEV TYPE=MT START
SLOT=MECHSLOTS(GPCT_MECHINDEX+MECH)
FINISH
FINISH
FINISH ELSE SLOT=STRMQ(GPCNO<<4!STRM)
! IF NO SLOT, ASSUME SPURIOUS
FLAG=2
IF SLOT=ENDLIST THEN ->SPURIOUS INTERRUPT
*JLK_<DO MAPPINGS>
FLAG=3
IF MULTI OCP=YES AND BUSY>0 START ; ! Other OCP doing timeout
->MORE INTS; ! so ignore int.
FINISH
IF STATE=NOT ALLOCATED THEN ->SPURIOUS INTERRUPT
IF INTERRUPT ANALYSIS FLAGS=1 START
! ATTENTION
ACT=3
Q_P1=RESP0
*JLK_<RESPOND>
->MORE INTS
FINISH
! NOT AN ATTENTION INTERRUPT
IF STATE=SENSE FIRED START
IF D_LOGMASK&BYTEINTEGER(ADDR(D_SENSE1))#0 START
DUMPTABLE(70+GPCT_DEVTYPE,ADDR(D),D_DEVICE ENTRY S)
FINISH
GS3:
ACT=5
Q_P1=D_RESP0
Q_P2=D_RESP1
Q_P4=RESP0>>16
Q_P5=GPCT_C STATUS
*JLK_<RESPOND>
->TRY NEXT
FINISH
IF STATE=REQUEST FIRED START
D_RESP0=RESP0
D_RESP1=RESP1
IF RESP0&ABNORMAL TERMINATION#0 C
AND GPCT_RESPONSE DEST>>16<65 START
! LEAVE SLOT AS FIRST IN LIST AND ISSUE SENSE
J=D_LOGMASK>>8
IF RESP0&X'00FF0000'=CONTROLLER DETECTED ERROR C
OR J#0 START
WK="GPC abterm ".HTOS(PT<<4!STRM,3)." ".MNS(D). C
" ".HTOS(RESP0,8)
MSG(WK)
J=READ STRM DATA(PT,STRM,2);!READ CONTROL STREAM STATUS
J=READ STRM DATA(PT,STRM,0);!READ STREAM DATA
!* J=READ STRM DATA(PT,STRM,1)
!READ STREAM'S CONTROLLER STATUS
IF GPCT_DEV TYPE=FE AND RESP0&X'FF0000'= C
CONTROLLER DETECTED ERROR C
THEN CONNECT STREAMS(PT,CAA,STRM,1,0)
! RE CONNECT FE AFTER ABTERM AND CDE
FINISH
IF GPCT_FLAGS&GETSTRMDATA#0 START
GPCT_CSTATUS=READ STRM DATA(PT,STRM,1)
! READ STREAM'S CONTROLLER STATUS
->GS3
FINISH
IF CA_PAW#0 THEN PAW NOT CLEARED(PT,STRM,CA_PAW)
*JLK_<GET CA>
CA_PAW=DO STREAM REQUEST!STRM
SENT_SAW0=X'10000020'; ! INTS + RCB BOUND
SENT_SAW1=D_GRCB A
! DO NOT SEND AN INIT WORD (IN THE CASE OF MT WE ARE ADDRESSING THE MECHANISM
! ALREADY SELECTED)
*JLK_<SEND CH FLAG>
GPCT_STATE=SENSE FIRED
->MORE INTS
FINISH
ACT=2
Q_P1=RESP0
Q_P2=RESP1
*JLK_<RESPOND>
IF RESP0&NORMAL TERMINATION#0 C
OR (RESP0&ABNORMAL TERMINATION#0 C
AND GPCT_RESPONSE DEST>>16>64) THEN ->TRY NEXT
->MORE INTS
FINISH
FLAG=4
! HM WE APPEAR TO HAVE A NON ATTENTION INTERRUPT WHEN
! STATE IS READY/QUEUED
SPURIOUS INTERRUPT:
J=SPURIOUS INTS(STRM)
SPURIOUS INTS(STRM)=J+1
IF J<SPURIOUS LIMIT START
MSG("GPC spurious int on ".HTOS(PT<<4!STRM,3)."/".HTOS( C
RESP0,8))
FINISH
IF J=SPURIOUS LIMIT AND BUSY=0 START
CONNECT STREAMS(PT,CAA,STRM,0,0)
UNLESS SLOT=ENDLIST THEN GPCT_STATE=DISCONNECTED
FINISH
->MORE INTS
TRY NEXT:
! A PREVIOUS REQUEST HAS BEEN COMPLETED (SOMEHOW) SO NOW
! MARK THAT SLOT 'READY' AGAIN AND SEE IF THERE ARE ANY
! OTHER REQUESTS QUEUED FOR THAT STREAM
IF MULTI OCP=YES START
*JLK_<GET STRM SEMA>
FINISH
GPCT_STATE=READY
QHD=GPCT_LINK
GPCT_LINK=ENDLIST
IF QHD#ENDLIST START
SLOT=QHD
*JLK_<DO MAPPINGS>
! TAKE NEXT REQUEST AND INITIATE
IF CA_PAW#0 THEN PAW NOT CLEARED(PT,STRM,CA_PAW)
*JLK_<GET CA>
CA_PAW=D_PAW
SENT_SAW0=D_USAW0; ! SAW FLAGS + RCB BOUND
SENT_SAW1=D_URCB A
! FREE COMMS AREA SEMAPHORE AND SEND CHANNEL FLAG
*JLK_<SEND CH FLAG>
GPCT_STATE=REQUEST FIRED
FINISH
IF MULTI OCP=YES START
INTEGER(SEMA)=-1; ! RELEASE SEMAPHORE
FINISH
->MORE INTS
!*
GS(7): ! ENTRY FOR RECONFIGURE ROUTINE
! P_P1 = IDENT
! P_P2 = SAC
I=P_P2
P_P2=0
FOR SLOT=0,1,LASTSLOT CYCLE
GPCT==RECORD(GPCT BASE+SLOT*SLOTSI)
IF GPCT_PTSM>>12&15=I AND GPCT_STATE&15#DISCONNECTED START ; ! SAC IN USE
P_P2=3<<24!GPCT_MNEMONIC
EXIT
FINISH
REPEAT
->ACK1
GS(9): ! entry from SHUTDOWN routine
! P_P1 = pt
IF COM_NSACS=1 AND COM_SACPORT0#P_P1>>4 THEN ->ACK1; ! SAC gone
FOR SLOT=0,1,LAST SLOT CYCLE
*JLK_<DO MAPPINGS>
IF PT=P_P1 START
XRCB==RECORD(D_GRCB A)
IF GPCT_DEVTYPE=MT START
XRCB_LIM FLAGS=X'C000'
I=XRCB_INIT WORD&X'FF'
I=3 IF I=0
XRCB_INIT WORD=MECH<<24!I
FINISH ELSE XRCB_LIM FLAGS=PRIV ONLY
INTEGER(XRCB_LBA)=X'80F01800'
LONGINTEGER(XRCB_ALA)=X'5800000481000000'
XRCB_LBS=4
XRCB_ALS=8
*JLK_<GET CA>
CA_PAW=DO STREAM REQUEST!STRM
CA_PIW0=0
SENT_SAW0=3<<28!RCB BOUND
SENT_SAW1=ADDR(XRCB)
SENT_RESP0=0
SENT_RESP1=0
*JLK_<SEND CH FLAG>
WAIT(10)
FINISH
REPEAT
WAIT(100)
->ACK1
GS(10): ! Reinit GPC
! P_P1 = PT
! P_P2 = OLD PT IF >=0
PT=P_P1
IF P_P2>=0 AND PT#P_P2 START ; ! SAC switch
! *** not implemented protem - grope table requires extension ***
OPMESS("Cannot switch GPCs")
->ACK1
FINISH
IF LOPT<=PT<=HIPT AND BYTEINTEGER(COM_CONTYPEA+PT)=3 START
GPC NO=PT TO GPC(PT-LOPT)
I=GPC INIT(CAAS(GPC NO),PT,0); ! Reinitialise GPC
IF I=0 THEN WK=" reinitialised" ELSE WK=" reinit fails"
OPMESS("GPC ".HTOS(PT,2).WK)
FINISH ELSE OPMESS("Cannot reinit GPC ".HTOS(PT,2))
->ACK1
GS(*):
PKMONREC("GPC bad DACT:",P)
->OUT
ACKNOWLEDGE:
P_P1=FLAG
ACK1:
P_DEST=SRCE
P_SRCE=GPC DEST!DACT
IF CALLED=0 AND SRCE>>16#0 THEN PON(P)
OUT:
INP=P
IF KMONNING=YES START
PKMONREC("GPC( out):",P) IF GMON=YES
FINISH
RETURN
!*
! CDS DEV ON
! 'FIND' AND 'DO MAPPINGS' HAVE BEEN DONE
CDS ON:
IF XINIT=0 START
! ON FIRST CALL, SET UP RCB ETC
XINIT=1
XA=ADDR(X(0))
XRCB==RECORD(XA)
XRCB_LIMFLAGS=X'4000'; ! TRUSTED CHAIN
XRCB_LSTA=0
XRCB_LB S=32
XRCB_AL S=32
XRCB_AL A=XA+32
XALE==ARRAY(XRCB_AL A,ALEFF)
XALE(0)_S=8
XALE(0)_A=XA+64; ! PROPSDATA
XALE(1)_S=12
XALE(1)_A=XA+72; ! SENSE DATA
XALE(2)_S=384
XALE(2)_A=XA+84; ! LP REPERTOIRE
XALE(3)_S=4
XALE(3)_A=XA+468; ! LP INITWORD
FINISH
UNLESS XPT<0 START
REPLY(SRCE,"GPC: CDS already active")
RETURN
FINISH
! REMEMBER WHAT WE'RE LOOKING FOR!
XSRCE=SRCE
PIW0=0; ! SO THAT WE CAN ->MORE INTS WITH IMPUNITY
XSLOT=SLOT
XMNEMONIC=MNEMONIC
XDEVTYPE=GPCT_DEVTYPE
XPTS=GPCT_PTSM>>4&X'FFF'
XGPC=0
GLOOP:
XPT=TABLE(16+XGPC)
IF RECONFIGURE=YES START ; ! SAC may be configured out
IF COM_NSACS=1 START
UNLESS XPT>>4=COM_SACPORT0 THEN ->SKIPG; ! SAC GONE
FINISH
FINISH
XCAA=TABLE(8+XGPC)
XCA==RECORD(XCAA)
XSTRM=0
SLOOP:
XSTATE=-1; ! NOTHING FIRED
SLOT=PTS TO SLOT((XPT-LOPT)<<4!XSTRM)
IF SLOT=255 THEN ->CONNECT
GPCT==RECORD(GPCT BASE+SLOT*SLOTSI)
UNLESS GPCT_STATE&15=DISCONNECTED THEN ->SKIP
CONNECT:
! NOW FOUND A STRM THAT EITHER HAS NO SLOT
! ASSOCIATED WITH IT OR HAS A SLOT WHICH
! HAS BEEN DISCONNECTED
XSENT==XCA_S ENTRY(XSTRM)
X(16)=0
XSTATE=1; ! CONNECT
->XFIRE
! RESPONSE FROM CONNECT
CDS(1):
IF X(16)>>24>0 START
! FIRST BYTE OF PROPS DATA GIVES DEVTYPE,
! ZERO IF NO DEVICE
IF X(16)>>24=XDEVTYPE START
! DEV OF RIGHT TYPE
! if MT, next byte gives cluster id
! if FE, next byte gives FE no.
! if SU, next byte gives SU no.
UNLESS (XDEVTYPE=MT AND XMNEMONIC&X'F00'#X(16)>>12 C
&X'F00') OR (XDEVTYPE=FE C
AND XMNEMONIC&15#X(16)<<8>>24) OR C
(XDEVTYPE=SU AND XMNEMONIC&15#X(16)<<8>>24) THEN ->XFOUND
FINISH
! IF FOUND A DEVICE OF WRONG TYPE, DISCONNECT IT
XSTATE=0; ! DISCONNECT
->XFIRE
FINISH
! RESPONSE FROM DISCONNECT
CDS(0):
SKIP:
UNLESS XSTRM=14 THEN XSTRM=XSTRM+1 AND ->SLOOP
SKIPG:
UNLESS XGPC=NO OF GPCS-1 THEN XGPC=XGPC+1 AND ->GLOOP
REPLY(XSRCE,"GPC: ".MNEMO(XMNEMONIC)." not found")
XPT=-1
XSTRM=-1
IF XSTATE<0 THEN RETURN ELSE ->MORE INTS
XFOUND:
REPLY(XSRCE,"GPC: ".MNEMO(XMNEMONIC)." now on pts ".HTOS( C
XPT<<4!XSTRM,3))
PTS TO SLOT(XPTS-(LOPT<<4))=255
PTS TO SLOT((XPT-LOPT)<<4!XSTRM)=XSLOT
XGPTSM=(XGPC<<16)!(XPT<<8)!(XSTRM<<4)
FOR SLOT=0,1,LASTSLOT CYCLE
GPCT==RECORD(GPCT BASE+SLOT*SLOTSI)
IF (GPCT_PTSM>>4)&X'FFF'=XPTS START
! MOVE EVERYTHING ON THIS PTS
D==RECORD(GPCT_DEVICE ENTRY A)
D_GPTSM=XGPTSM!(D_GPTSM&15)
GPCT_PTSM=D_GPTSM
D_CAA=XCAA
GPCT_STATE=GPCT_STATE>>4
FINISH
REPEAT
UNLESS XDEVTYPE=LP THEN ->XOUT
! FIRST BUILD A TRANSLATE TABLE IN
! THE DEVICE ENTRY TO FILTER OUT INVALID CHARACTERS
XCART=(X(17)>>16)&15
XA=REPERTOIRE A(XCART)
REP==ARRAY(XA,BIFT)
XS=REPERTOIRE S(XCART)
TRTAB==ARRAY(D_TRTABLE A,BIFT)
FOR I=0,1,255 CYCLE ; TRTAB(I)=I; REPEAT
UNLESS XCART=0 START
FOR I=0,1,255 CYCLE
IF FIND BYTE(I,XA,XS)<0 START
! NOT IN REP
IF FIND BYTE(I,ADDR(LCLETTS(1)),26)<0 START
TRTAB(I)=LP ILLCHAR
FINISH ELSE START
TRTAB(I)=I!X'40'; ! MAKE UC LETTER
FINISH
FINISH
REPEAT
TRTAB(37)=X'15'
TRTAB(21)=X'15'
TRTAB(12)=X'0C'; ! NEWLINE
TRTAB(13)=X'0D'
TRTAB(64)=X'40'; ! SPACE
FINISH
! X(16) HAS BYTES 0-3 OF LP PROPERTIES
! X(17) 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 PO DPS CRAIGLOCKHART 2970
! 3 WE LOAD THE 384-CHAR REP FOR THE BUSH ESTATE 2980
! 4 WE LOAD THE 64-CHAR REP FOR THE PO DPS BARBICAN 2970
! 5 WE LOAD THE 96-CHAR REP FOR THE ERCC-KB 2970
XSTYLE=X(16)&255
XLEN=(XSTYLE>>4)*10+XSTYLE&15
XLEN=66 IF XLEN=0
XLBE(6)=(XLBE(6)&(¬255))!(XLEN-1)
FOR I=0,XS,384-XS CYCLE
MOVE(XS,XA,ADDR(X(21))+I)
REPEAT
X(117)=X'00000010'; ! BACK ? FOR ILLEGAL, AUTOTHROW NOT SET
XSTATE=5; ! INITIALISE OUTWARDS
->XFIRE
CDS(5): ! RESP FROM INIT
IF XCART=0 AND X(17)&X'100000'=0 THEN ->CDS(4)
XSTATE=4; ! LOADREP OUTWARDS
->XFIRE
CDS(4): ! RESP FROM LOAD REP
X(117)=X'0000FC10'
XSTATE=7; ! ANOTHER INIT
->XFIRE
CDS(7): ! RESP FROM SECOND INIT
IF XSTYLE=X'99' THEN ->XOUT
XSTATE=6; ! WRITE CONTROL
->XFIRE
CDS(6): ! RESP FROM WRITE CONTROL
XOUT:
XPT=-1
XSTRM=-1
->MORE INTS
XFIRE:
! NEEDS XCAA, XSENT, XPT, XSTRM SETTING UP OUTSIDE
! USES XSTATE TO SELECT REQUIRED COMMAND
IF XCA_PAW#0 OR XSENT_SAW0#0 START
PAW NOT CLEARED(XPT,XSTRM,XCA_PAW)
FINISH
XRCB_LBA=ADDR(XLBE(XSTATE))
SLAVES ON OFF(0); ! SLAVES OFF
GET CA(XCAA)
XCA_PAW=DO STREAM REQUEST!XSTRM
XSENT_SAW0=X'30000020'
XSENT_SAW1=ADDR(XRCB)
XSENT_RESP0=0
XCA_MARK=-1
SEND CH FLAG(XPT)
FOR I=1,1,COM_INSPERSEC*150 CYCLE ; ! wait about 1 sec
EXIT IF XSENT_RESP0#0
REPEAT
XCA_PIW0=XCA_PIW0&(¬(X'80000000'>>XSTRM));! NO SURPRISE INTS.
XSENT_RESP0=0
SLAVES ON OFF(-1); ! BACK ON
->CDS(XSTATE); ! PROCESS RESPONSE
!*
! PSEUDO ROUTINE
! SENDS A RESPONSE AFTER AN INTERRUPT HAS
! BEEN ANALYSED
!*
RESPOND:
Q_DEST=GPCT_RESPONSE DEST
IF GPCT_DEVTYPE=OP THEN Q_DEST=Q_DEST!((GPCT_MECHINDEX>>4)<< C
8)
Q_SRCE=GPC DEST!3
BYTEINTEGER(ADDR(Q_P1))=LOID+SLOT
Q_P3=ADDR(D)
Q_P6=D_IDENT
IF KMONNING=YES AND GMON=YES THEN PKMONREC("GPC( PONS):",Q)
PON(Q)
*J_TOS
!* END OF RESPOND
!*
! PSEUDO ROUTINE
! GIVEN MNEMONIC, SEARCHES FOR CORRESPONDING SLOT
! OR, IF NOT FOUND, SETS SLOT TO -1
!*
FIND:
SLOT A=GPCT BASE
FOR SLOT=0,1,LAST SLOT CYCLE
GPCT==RECORD(SLOTA)
IF MNEMONIC=LOID+SLOT OR MNEMONIC=GPCT_MNEMONIC C
OR MNEMONIC=GPCT_PTSM&X'FFFF' C
OR (MNEMONIC=M'LP' AND GPCT_MNEMONIC>>8=M'LP' C
AND GPCT_PROPS03&X'80'=0) THEN START
*J_TOS
FINISH
SLOT A=SLOT A+SLOTSI
REPEAT
IF MNEMONIC=M'LP' START
MNEMONIC=M'LP0'
->FIND
FINISH
SLOT=-1
*J_TOS
!* END OF FIND
!*
! PSEUDO ROUTINE
! GIVEN SLOT, SETS VARIOUS POINTERS
!*
DO MAPPINGS:
GPCT==RECORD(GPCT BASE+SLOT*SLOTSI)
D==RECORD(GPCT_DEVICE ENTRY A)
GPTSM=GPCT_PTSM
GPC NO=GPTSM>>16
PT=(GPTSM>>8)&255
STRM=(GPTSM>>4)&15
MECH=GPTSM&15
STATE=GPCT_STATE&15
BUSY=GPCT_BUSY
CAA=CAAS(GPC NO)
QHD==STRMQ(GPC NO<<4+STRM)
CA==RECORD(CAA)
SENT==CA_S ENTRY(STRM)
*J_TOS
!* END OF DO MAPPINGS
!*
! PSEUDO ROUTINE
!*
GET CA:
*LXN_CAA
*INCT_(XNB +0)
*JCC_8, <GOT>
SEMALOOP(INTEGER(CAA),2)
GOT:
*J_TOS
!* END OF GET CA
!*
! PSEUDO ROUTINE
GET STRM SEMA:
SEMA=ADDR(STRM SEMAPHORE(GPCNO<<4!STRM))
*LXN_SEMA
*INCT_(XNB + 0)
*JCC_8, <GOT SS>
SEMALOOP(INTEGER(SEMA),2)
GOT SS:
*J_TOS
!* END OF GET STRM SEMA
!*
! PSEUDO ROUTINE
!*
SEND CH FLAG:
CA_MARK=-1
BREG=TRUNKADDR!(PT<<16)
*LB_BREG
*LSS_1
*ST_(0 + B )
*J_TOS
!* END OF SEND CH FLAG
!*
END ; ! OF GPC
!*
IF CSU FITTED=YES START
EXTERNALROUTINE CSU(RECORD (PARMF)NAME P)
RECORD (PARMF) Q
RECORD (DEVICE ENTRY F)NAME D
SWITCH ACT(0:10)
OWNINTEGERARRAY DTODA(0:9)=NOT ALLOCATED(*)
CONSTINTEGER CSU SNO=CSU DEST>>16
IF KMONNING=YES AND KMON>>CSU SNO&1#0 THEN PKMONREC("CSU :",P)
->ACT(P_DEST&255)
ACT(0): ! initialise call from GPC
Q=0
Q_DEST=GPC DEST!11; ! allocate
Q_SRCE=P_DEST!1
Q_P1=P_P1
Q_P2=P_DEST!5; ! interrupts to ACT 5
PON(Q)
RETURN
ACT(1): ! reply from allocate
UNLESS P_P1=0 START ; ! failed
BYTEINTEGER(ADDR(P_P6))=3
OPMESS(STRING(ADDR(P_P6))." alloc fails ".HTOS(P_P1,1))
RETURN
FINISH
D==RECORD(P_P3)
DTODA(P_P6&255-'0')=P_P3
RETURN
ACT(2): ! deallocate
RETURN
ACT(3): ! deallocate reply
RETURN
ACT(5): ! interrupt from GPC
RETURN
ACT(6): ! switch device
RETURN
ACT(7): ! switch controller
RETURN
END
FINISH
ENDOFFILE