%CONSTSTRING(25) VSN = "GPC34 17TH NOV 80"; ! ************************************************GPC GPC GPC
!
! EMAS 2900 SUPERVISOR NOTE
! No: 5
! Date: 21/05/80
! Author: A.Gibbons
!
!
! %EXTERNAL ROUTINE GPC(%RECORDNAME 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 device not allocated
! 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, CALLED NOT PON'D
! P1 = PTSM
! RESPONSE
! P1 = 0 success
! 1 mnemonic invalid
! 2 stream disconnected
! P3 = address of device entry (unless P1 = 1)
!
!
!
! 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
!
!
!
!
!
!----------------------------------------------------------------------------------------------------
%EXTERNALINTEGERFNSPEC REALISE(%INTEGER I)
%EXTERNALROUTINESPEC SLAVESONOFF(%INTEGER ONOFF); ! 0=OFF, -1=ALL ON
%EXTERNALROUTINESPEC GET PSTB(%INTEGERNAME PSTB0,PSTB1)
%EXTERNALROUTINESPEC SEMALOOP(%INTEGERNAME SEMA)
%EXTERNALROUTINESPEC CONTROLLER DUMP(%INTEGER CONTYPE,PT)
%EXTERNALROUTINESPEC WAIT(%INTEGER MILLISECONDS)
%EXTERNALROUTINESPEC DUMP TABLE(%INTEGER TABNO,ADR,LEN)
%EXTERNALROUTINESPEC PKMONREC(%STRING(20)TXT,%RECORDNAME P)
%EXTERNALSTRINGFNSPEC HTOS(%INTEGER I,PL)
%EXTERNALROUTINESPEC PON(%RECORDNAME P)
!%EXTERNALROUTINESPEC OPMESS2(%INTEGER OPER, %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'
%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 = 20
%CONSTINTEGER TICK INTERVAL = 2
%CONSTINTEGER TRUNKADDR = X'40000800'
%CONSTINTEGER COMADDR=X'80C00000'
%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
%EXTERNALINTEGER LOPT
%EXTERNALINTEGER HIPT; ! TO TRAP WAYWARD PON
%OWNINTEGER MECHPT
%OWNINTEGER NO OF GPCS
%OWNINTEGER PT GPC BASE
%OWNINTEGER PTS BASE
%OWNINTEGER RECAT
%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 1
%ENDOFLIST
%OWNINTEGERARRAY GPCMPROG(0:511)= %C
X'F160F171',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'C2738005',
X'9062805F',X'B21AA27A',X'A29A82D9',X'B809A674',
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'C0C0818A',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'0835282C',
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'A3344D8A',X'1005B715',X'F9C00C55',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'00000000',
X'00000000',X'00000000',X'00000000',X'00000000',
X'00000000',X'00000000',X'00000000',X'00000000',
X'00000000',X'00000000',X'00000000',X'00000000',
X'00000000',X'00000000',X'00000000',X'0000F2B2',
X'B80AA213',X'498D9800',X'0C030001',X'ED81ADFB'
%LIST
!
!
!----------------------------------------------------------------------------------------------------
!* COMMUNICATIONS RECORD FORMAT - EXTANT FROM CHOPSUPE 20J ONWARDS *
%RECORDFORMAT COMF(%INTEGER OCPTYPE,IPLDEV,SBLKS,SEPGS,NDISCS, %C
DDTADDR,GPCTABSIZE,GPCA,SFCTABSIZE,SFCA,SFCK,DIRSITE, %C
DCODEDA,SUPLVN,TOJDAY,DATE0,DATE1,DATE2, %C
TIME0,TIME1,TIME2,EPAGESIZE,USERS,CATTAD,DQADDR, %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,SP1, %C
SP2,SP3,SP4,SP5,SP6,SP7,SP8, %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 %C
S, %C
A)
!----------------------------------------------------------------------------------------------------
%RECORDFORMAT CA0F(%INTEGER %C
MARK, %C
PAW, %C
PIW0, %C
PIW1, %C
CSAW0, %C
CSAW1, %C
CRESP0, %C
CRESP1); ! LENGTH OF THIS RECORD FORMAT IS X'20'
!----------------------------------------------------------------------------------------------------
%RECORDFORMAT CASEF(%INTEGER %C
SAW0, %C
SAW1, %C
RESP0, %C
RESP1)
!----------------------------------------------------------------------------------------------------
%RECORDFORMAT CAF(%INTEGER %C
MARK, %C
PAW, %C
PIW0, %C
PIW1, %C
CSAW0, %C
CSAW1, %C
CRESP0, %C
CRESP1, %C
%RECORDARRAY S ENTRY(0:14)(CASEF)); ! LENGTH X'110'
!----------------------------------------------------------------------------------------------------
%RECORDFORMAT DEVICE ENTRY F(%INTEGER %C
X1, %C
GPTSM, %C
PROP A, %C
SECS SINCE, %C
CA A, %C
G RCB A, %C
LB A, %C
AL A, %C
X2, %C
RESP0, RESP1, %C
SENSE1, SENSE2, SENSE3, SENSE4, %C
X3, X4, %C
IDENT, %C
X5, %C
MNEMONIC, %C
DEVICE ENTRY S, %C
PAW, %C
U SAW 0, %C
U RCB A, %C
SENSE DATA A, %C
LOG MASK, %C
TR TABLE A, %C
UA S, %C
UA A, %C
TIMEOUT, %C
PROPS0, PROPS1)
!----------------------------------------------------------------------------------------------------
! FLAGS : ONLY ONE BIT USED 'GET STRM DATA'
! BUSY : MULTI-OCPS ONLY. MUST HOLD STRM SEMA TO SET
! : 0 = OK
! : 1 = PROCESSING INTERRUPT
! : 2 = TIMING OUT
! STATE : VALID STATES ARE
! 0 NOT ALLOCATED
! 1 READY
! 2 REQUEST FIRED
! 3 SENSE FIRED
! 4 QUEUED
! 5 DISCONNECTED
%RECORDFORMAT GPCT F( %C
%BYTEINTEGER %C
FLAGS, %C
DEVTYPE, %C
BUSY, %C
LINK, %C
%INTEGER %C
X4, %C
RESPONSE DEST, %C
DEVICE ENTRY A, %C
C STATUS, %C
PTSM, %C
MNEMONIC, %C
%BYTEINTEGER %C
MECHINDEX, %C
PROPS03, %C
SERVRT, %C
STATE)
!----------------------------------------------------------------------------------------------------
%RECORDFORMAT INIF(%INTEGER %C
PSTS, %C
PSTA, %C
CAA, %C
SOE)
!----------------------------------------------------------------------------------------------------
%RECORDFORMAT PARMF(%INTEGER %C
DEST, %C
SRCE, %C
P1,P2,P3,P4,P5,P6)
!----------------------------------------------------------------------------------------------------
! LIMFLAGS
! BITS 0-13 BOUND OF LOCAL SEGMENT TABLE
! 16-23 FLAGS
! 16 INITWORD IS VALID
! 17 TRUSTED COMMAND CHAIN
! 28-31 ACR
! LB S,A LOGIC BLOCK DESCRIPTOR
! AL S,A ADDRESS LIST DESCRIPTOR
! INITWORD
! BITS 0- 7 MECH
! 8-15 COMMAND MASK
! 16-23 STATUS MASK
! 24-31 MODE
%RECORDFORMAT RCB F(%INTEGER %C
LIM FLAGS, %C
LOCAL SEG TABLE A, %C
LB S, %C
LB A, %C
AL S, %C
AL A, %C
INIT WORD, %C
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, %C
XGPC, XCAA, XGPTSM, XPTS, XSTATE, XSRCE
%OWNINTEGER XCART, XSTYLE, XLEN, XS
%OWNINTEGERARRAY X(0:117)
%OWNRECORDNAME XRCB(RCBF)
%OWNRECORDNAME XCA(CAF)
%OWNRECORDNAME XSENT(CASEF)
%OWNRECORDARRAYFORMAT ALEFF(0:3)(ALEF)
%OWNRECORDARRAYNAME XALE(ALEF)
%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=5
%CONSTINTEGERARRAY CDMDEV(0:CDMDEVLIMIT)=%C
M'FE',M'LP',M'CR',M'CP',M'PR',M'PT'
%CONSTBYTEINTEGERARRAY CDMDEVTYPE(0:CDMDEVLIMIT)=14,6,4,3,2,1
%CONSTINTEGERARRAY CDMDEVTIMEOUT(0:CDMDEVLIMIT)=%C
X'01FF0003',60,300,600,60,60; ! 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.
!----------------------------------------------------------------------------------------------------
! JUST PRINTS A STRING + NEWLINE
%ROUTINE MSG(%STRING(120)TXT)
PRINTSTRING(TXT."
")
%END; ! OF MSG
!
!
%ROUTINE REPLY(%INTEGER SRCE, %STRING(63)TXT)
%RECORD P(PARMF)
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
!
!
!
!
! PONS A PSEUDO INTERRUPT ENTRY TO GPC
%ROUTINE PON GPC INT(%INTEGER PT)
%RECORD P(PARMF)
%UNLESS LOPT<=PT<=HIPT %THEN INTEGER(-1)=1; ! TRAP WAYWARD PON
P_SRCE=0
P_DEST = GPC DEST ! 3; ! INTERRUPT ENTRY
P_P1 = PT
PON(P)
%END; ! OF PON GPC INT
!
!
!
!
!
! GETS A COMMUNICATION AREA
%ROUTINE GET CA(%INTEGER CAA)
*LXN_CAA
*INCT_(%XNB+0)
*JCC_8, <GOT>
SEMALOOP(INTEGER(CAA))
GOT:
%END; ! OF GET CA
!
!
!
!
!
! SENDS A CHANNEL FLAG
%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
! CONTROLLER RESPONSES SAVED IN MAINSTORE,
! ADDR X'2000' INSTEAD OF DUMP TABLE BEING
! CALLED
! COMMS AREA COPIED
! 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( %C
%INTEGER CAA, %C
%INTEGER PT, %C
%INTEGER CHOPSUPE)
%INTEGER BREG
%INTEGER COUNT
%INTEGER J
%INTEGER PSTA
%INTEGER PSTS
%RECORDNAME CA0(CA0F)
%RECORDNAME CA(CAF)
%RECORD INI(INI F)
! CLEAR GPC
BREG = TRUNKADDR !(PT << 16)
*LSS_2
*LB_BREG
*ST_(0+%B)
WAIT(50); ! MILLISECONDS
CA0 == RECORD(RA0AD); ! INITIAL COMMS AREA
! 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 %THEN %C
%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
! IF CALLED FROM GROPE :
%IF CHOPSUPE # 0 %START
%IF RECAT = 0 %THEN RECAT = RA0AD + X'2000'
%CYCLE J = 0, 4, 28
INTEGER(RECAT+J) = INTEGER(RA0AD+J)
%REPEAT
%CYCLE J = 0, 4, 12
INTEGER(RECAT+X'20'+J) = INTEGER(ADDR(INI)+J)
%REPEAT
RECAT = RECAT + X'40'
%FINISH
! 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 CHOPSUPE = 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
%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 %C
PT, %C
CAA, %C
STREAM, %C
CONNECT, %C
TIMEOUT)
%INTEGER COUNT
%INTEGER FAILS
%INTEGER HI
%INTEGER J
%INTEGER LO
%INTEGER PAW FAILS
%INTEGER STRM
%OWNINTEGER DUMMY WORD
%OWNRECORD ALE(ALEF); ! ********************** BUT WHAT ABOUT MULTI PROCESSORS ???????
%OWNRECORD RCB(RCBF)
%RECORDNAME CA(CAF)
%RECORDNAME GPCT(GPCTF)
%RECORDNAME SENT(CASEF)
%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 %C
LO = 0 %AND HI = 14 %ELSE %C
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). %C
", PAW FAILS=".HTOS(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)
%CYCLE J = 0, 1, LASTSLOT
GPCT == RECORD(GPCTBASE + J*SLOTSI)
STRM = (GPCT_PTSM >> 4) & 15
%IF (GPCT_PTSM >> 8) & 255 = PT %C
%AND %C
(GPCT_STATE = REQUEST FIRED %C
%OR %C
GPCT_STATE = SENSE FIRED) %C
%AND %C
(STRM = STREAM %OR STREAM < 0) %C
%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:
%CYCLE J = LO, 1, HI
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 %C
%OR COUNT > 100000
%IF SENT_RESP0 & NORMAL TERMINATION = 0 %START
MSG(TXT." STRM".HTOS(J,1). %C
" RESP0=".HTOS(SENT_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 %C
PT, %C
STREAM, %C
PAW)
%INTEGER CAA
%INTEGER GPCNO
%INTEGER SAW
%RECORDNAME CA(CAF)
%RECORDNAME SENT(CASEF)
! 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(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 %C
PT, %C
STREAM, %C
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)
%RECORDNAME CA(CAF)
%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 %C
%OR COUNT > 100000
! SLAVES BACK ON
SLAVES ON OFF(-1)
%IF MULTIOCP = YES %START; RESERVE LOG; %FINISH
PRINTSTRING("GPC ".HEADER(CONTROLLER). %C
" PTS=".HTOS(PT<<4!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
%CYCLE I = 0, 1, LEN-1
%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)
TRIM: %IF S -> (" ").S %THEN ->TRIM
%IF S -> ("X").S %START
%CYCLE I = 1, 1, BYTEINTEGER(A)
J = BYTE INTEGER(A+I)
%UNLESS '0' <= J <= '9' %OR %C
'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
%CYCLE I = 1, 1, 3
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
%RECORDNAME G(GPCT F)
%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
%CYCLE J = 0, 1, LASTSLOT
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(%RECORDNAME D)
%RECORDSPEC D(DEVICE ENTRY F)
%INTEGER I
I=D_MNEMONIC
BYTEINTEGER(ADDR(I))=3
%RESULT=STRING(ADDR(I))
%END; ! MNS
!----------------------------------------------------------------------------------------------------
!
!
!
!
!
! MAIN GPC ROUTINE
!
!
!
!
!
%EXTERNALROUTINE GPC(%RECORDNAME INP)
%RECORDSPEC INP(PARMF)
%INTEGER DSNO,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 STATE
%INTEGER GMON
%INTEGER ACT
%STRING(15) MNEMOS
%RECORD P(PARMF)
%RECORD Q(PARMF)
!
%OWNINTEGER SETUP=0
!
%BYTEINTEGERNAME QHD
%BYTEINTEGERARRAYNAME REP, TRTAB
!
%SWITCH G COMMAND(1:LIMIT)
%SWITCH GS(1:12)
%SWITCH CDS(0:7)
!
%RECORDNAME COM(COMF)
%RECORDNAME D(DEVICE ENTRY F)
%RECORDNAME CA(CAF)
%RECORDNAME SENT(CASEF)
%RECORDNAME GPCT,GE(GPCTF)
!
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)
%IF NO OF GPCS>1 %THEN HIPT=TABLE(15+NO OF GPCS) %C
%ELSE HIPT=LOPT; ! TO TRAP WAYWARD PON
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)
!
%CYCLE J = 0, 1, 15
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
%CYCLE J = 0, 1, LASTSLOT
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
%CYCLE J = 0, 1, LASTSLOT
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; ! DEVTYPE = OPER
!
%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; ! DEVTYPE = FE
!
%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; ! DEVTYPE MT
%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
!
!
!
!
!
!----------------------------------------------------------------------------------------------------
DSNO=P_DEST>>16
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)) . " * * *"
TRIM: %IF WK -> (" ").WK %THEN -> TRIM
%CYCLE J = 1, 1, LIMIT
%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: ". %C
MNEMO(GPCT_MNEMONIC)." ". %C
HTOS(GPCT_PTSM&X'FFFF',4)." ". %C
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)
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
COM==RECORD(COMADDR)
%IF MNEMONIC1>>8=M'ZX' %START; ! INTRODUCE DEVICE
I=MNEMONIC2>>8
%CYCLE J=0,1,CDMDEVLIMIT
%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 %C
COM_FEPS=COM_FEPS!1<<(16+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
%CYCLE J=0,1,CDMDEVLIMIT
%IF I=CDMDEV(J) %THEN ->TOUT
%REPEAT
->ERR
TOUT:
%IF CDMDEVTYPE(J)=FE %THEN %C
COM_FEPS=COM_FEPS&(\(1<<(16+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): ! ?
%CYCLE SLOT=0,1,LASTSLOT
GPCT == RECORD(GPCT BASE + SLOT * SLOTSI)
*JLK_<STATUS>
%REPEAT
!
! REPLY(SRCE, "GPC: ". %C
! "XPTS=".HTOS(XPT<<4!XSTRM,3). %C
! " XSTATE=".HTOS(XSTATE,1))
!
%RETURN
!----------------------------------------------------------------------------------------------------
!
!
! ALLOCATE ** NEW VERSION 9/79 **
!
! P1 = MNEMONIC
! P2 = DEST FOR INTERRUPT RESPONSES
!
!
GS(11):
! WK = "GPC ALLOCATE ".MNEMO(P_P1). %C
! " ".HTOS(P_P2,8)
MNEMONIC = P_P1
*JLK_<FIND>
%UNLESS SLOT < 0 %START
*JLK_<DO MAPPINGS>
FLAG = 2
%IF STATE = NOT ALLOCATED %START
FLAG = 0
GPCT_STATE = READY
GPCT_RESPONSE DEST = P_P2
! NOW CONSTRUCT THE REPLY
P_P2 = LOID + SLOT
P_P3 = ADDR(D)
P_P6 = GPCT_MNEMONIC
! EXTRA INFORMATION FOR OPERS
%IF GPCT_DEV TYPE = OP %START
! GET LOGICAL NO OF THIS OPER STREAM
OSNO = GPCT_MECHINDEX >> 4
! BUFF AREA ADDR
D_X2 = CAA + TABLE(OSNO + 32) >> 16
! NO OF SCREENS
D_RESP0 = GPCT_MECHINDEX & 15
! SIZE OF BUFFER AREA
D_X1 = TABLE(OSNO + 32) & X'FFFF'
%FINISH
%FINISH
%FINISH
! %IF FLAG = 0 %C
! %THEN MSG(WK."/".MNS(D)."/".HTOS(P_P2,2)) %C
! %ELSE MSG(WK." FLAG=".HTOS(FLAG,1))
-> ACKNOWLEDGE
!----------------------------------------------------------------------------------------------------
GS(8):
! SPECIAL FORCED ALLOCATE CALL (NOT PON)
! FOR USE BY ENTER
! P_P1 = PTSM
! ON RETURN
! P_P1 = 0 SUCCESS
! 1 MNEMONIC NOT KNOWN
! 2 DISCONNECTED
! P_P3 = ADDRESS OF DEVICE ENTRY
MNEMONIC = P_P1
*JLK_<FIND>
%UNLESS SLOT < 0 %START
*JLK_<DO MAPPINGS>
FLAG = 2
%UNLESS STATE = DISCONNECTED %START
FLAG = 0
P_P3 = ADDR(D)
%FINISH
%FINISH
P_P1 = FLAG
INP = P
%RETURN
!----------------------------------------------------------------------------------------------------
!
!
!
! DE-ALLOCATE
!
!
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
%UNLESS STATE = NOT ALLOCATED %OR STATE=QUEUED %START
GPCT_FLAGS = 0
GPCT_STATE = NOT ALLOCATED
FLAG = 0
%FINISH
%FINISH
%FINISH
! 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 GPC WITH PIW#0, PON GPC INT
! 2 FOR EACH BUSY SLOT, INCREMENT 'SECS SINCE'
! IF THIS BECOMES > TIMEOUT, ISSUE COPIOUS
! WARNINGS/DUMPS AND RECONNECT STREAM
PREVIOUS PT = 0
%CYCLE SLOT = 0, 1, LASTSLOT
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)
%UNLESS PT = PREVIOUS PT %OR CA_PIW0 = 0 %C
%THEN PON GPC INT(PT) %AND PREVIOUS PT = PT
%IF GE_STATE = REQUEST FIRED %C
%OR %C
GE_STATE = SENSE FIRED %C
%THEN %C
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)
!OPMESS2(0, 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 **
!
! P1 = RCB
! P2 = SNO FOR DEVICE
! P3 = RSD(1) + PAW FN(4) + SAWFLAGS(4)
! P4 = IDENT
!
!
GS(12):
SLOT = P_P2 - LOID
! CHECK THAT SLOT IN RANGE
%IF 0 <= SLOT <= LASTSLOT %THEN %START
*JLK_<DO MAPPINGS>
P3 = P_P3
D_IDENT = P_P4
P_P3 = ADDR(D)
P_P4 = 0
P_P5 = 0
P_P6 = D_IDENT
FLAG = 2
! CHECK DEVICE STATE
FLAGS = GPCT_FLAGS
%IF STATE = READY %START
PAW FN = P3 & X'F0'
U RCB A = P_P1
SAWFLAGS = P3 & 15
USAW0 = (SAWFLAGS << 28) ! RCB BOUND
PAW FN = (PAW FN << 20) ! STRM
! IF THIS STREAM IS IDLE, CAN ISSUE REQUEST FORTHWITH
%IF QHD = ENDLIST %START
%IF CA_PAW # 0 %C
%OR %C
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 MULTI OCP = YES %START
*JLK_<GET STRM SEMA>
!++; %FINISH
%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 %C
GPCT_FLAGS = FLAGS & (\GET STRM DATA) %C
%ELSE %C
GPCT_FLAGS = FLAGS ! GET STRM DATA
! 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
%IF MULTI OCP=YES %START
SLOT=PTS TO SLOT((PT-LOPT)<<4!STRM)
%UNLESS SLOT=ENDLIST %START
GPCT==RECORD(GPCT BASE+SLOT*SLOTSI)
*JLK_<GET STRM SEMA>
%UNLESS GPCT_BUSY=0 %THEN INTEGER(SEMA)=-1 %AND %C
->SPURIOUS INTERRUPT
GPCT_BUSY=PROCESSING INTERRUPT
INTEGER(SEMA)=-1
%FINISH
%FINISH
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
%IF MULTI OCP=YES %START
%UNLESS SLOT=ENDLIST %START
*JLK_<GET STRM SEMA>
GPCT_BUSY=0
INTEGER(SEMA)=-1
%FINISH
%FINISH
-> MORE INTS %IF INTERRUPT ANALYSIS FLAGS = 1; ! THROW AWAY ATTENTION INTERRUPTS
! REPLY(XSRCE,HTOS(XSTATE,1)." ". %C
! HTOS(RESP0,8)." ". %C
! HTOS(RESP1,8))
-> 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 STATE = NOT ALLOCATED %THEN -> SPURIOUS INTERRUPT
%IF INTERRUPT ANALYSIS FLAGS = 1 %START
! ATTENTION
ACT = 3
Q_P1 = RESP0
*JLK_<RESPOND>
%IF MULTI OCP=YES %START
*JLK_<GET STRM SEMA>
GPCT_BUSY=0
INTEGER(SEMA)=-1
%FINISH
-> MORE INTS
%FINISH
! NOT AN ATTENTION INTERRUPT
%IF STATE = SENSE FIRED %START
%IF D_LOGMASK & BYTEINTEGER(ADDR(D_SENSE1)) # 0 %START
%IF MULTIOCP = YES %START; RESERVE LOG; %FINISH
DUMPTABLE(70 + GPCT_DEVTYPE, ADDR(D), D_DEVICE ENTRY S)
%IF MULTIOCP = YES %START; RELEASE LOG; %FINISH
%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 ". %C
HTOS(PT << 4 ! STRM, 3)." ". %C
MNS(D)." ".HTOS(RESP0, 8)
MSG(WK)
!OPMESS2(0, 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 %C
%AND RESP0&X'FF0000'=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
%IF MULTI OCP=YES %START
*JLK_<GET STRM SEMA>
GPCT_BUSY=0
INTEGER(SEMA)=-1
%FINISH
-> MORE INTS
%FINISH
!
!
ACT = 2
Q_P1 = RESP0
Q_P2 = RESP1
*JLK_<RESPOND>
%IF RESP0&NORMAL TERMINATION#0 %OR %C
(RESP0&ABNORMAL TERMINATION#0 %AND %C
GPCT_RESPONSE DEST>>16>64) %THEN ->TRY NEXT
%IF MULTI OCP=YES %START
*JLK_<GET STRM SEMA>
GPCT_BUSY=0
INTEGER(SEMA)=-1
%FINISH
-> 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". %C
HTOS(PT << 4 ! STRM, 3). %C
"/".HTOS(RESP0, 8))
%FINISH
%IF J = SPURIOUS LIMIT %START
CONNECT STREAMS(PT, CAA, STRM, 0,0)
%UNLESS SLOT = ENDLIST %THEN GPCT_STATE = DISCONNECTED
%FINISH
%IF MULTI OCP=YES %START
*JLK_<GET STRM SEMA>
GPCT_BUSY=0
INTEGER(SEMA)=-1
%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
GPCT_BUSY=0
INTEGER(SEMA) = -1; ! RELEASE SEMAPHORE
!++; %FINISH
-> MORE INTS
!----------------------------------------------------------------------------------------------------
!
!
!
!
!
GS(7):
GS(10):
GS(4):
GS(2):
GS(9):
ACKNOWLEDGE:
P_DEST=SRCE
P_SRCE=GPC DEST ! DACT
P_P1=FLAG
%IF CALLED=0 %AND SRCE>>16#0 %START
PON(P)
%IF KMONNING = YES %START
PKMONREC("GPC( PONS):",P) %IF GMON = YES
%FINISH
%RETURN
%FINISH
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_LOCAL SEG TABLE A = 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 IN PROGRESS")
%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)
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.
%UNLESS (XDEVTYPE=MT %AND %C
XMNEMONIC&X'F00'#X(16)>>12&X'F00') %OR %C
(XDEVTYPE=FE %AND XMNEMONIC&15#X(16)<<8>>24) %C
%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
%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 ". %C
HTOS(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)
!
%CYCLE SLOT = 0, 1, LASTSLOT
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)
%CYCLE I=0,1,255; TRTAB(I)=I; %REPEAT
%UNLESS XCART = 0 %START
%CYCLE I = 0, 1, 255
%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)= %C
(XLBE(6)&(\255))!(XLEN - 1)
! REPLY(XSRCE,"GPC: LP CART=".HTOS(XCART,1). %C
! " L=X'".HTOS(XLEN,2)."'")
!
!
!
%CYCLE I = 0, XS, 384 - XS
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 %C
%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:
! REPLY(XSRCE,"END OF CDS")
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))
GET CA(XCAA)
XCA_PAW = DO STREAM REQUEST ! XSTRM
XSENT_SAW0 = X'10000020'
XSENT_SAW1 = ADDR(XRCB)
SEND CH FLAG(XPT)
XCA_MARK = -1
-> MORE INTS
!
!
!
!----------------------------------------------------------------------------------------------------
!
!
! 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 ! %C
((GPCT_MECHINDEX>>4)<<8)
Q_SRCE=GPC DEST ! 3
BYTEINTEGER(ADDR(Q_P1))=LOID + SLOT
Q_P3=ADDR(D)
Q_P6=D_IDENT
PKMONREC("GPC( PONS):",Q) %IF GMON = YES
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
%CYCLE SLOT = 0, 1, LAST SLOT
GPCT == RECORD(SLOTA)
%IF %C
MNEMONIC = LOID + SLOT %C
%OR %C
MNEMONIC = GPCT_MNEMONIC %C
%OR %C
MNEMONIC = GPCT_PTSM & X'FFFF' %C
%OR %C
(MNEMONIC = M'LP' %C
%AND %C
GPCT_MNEMONIC >> 8 = M'LP' %C
%AND %C
GPCT_PROPS03 & X'80' = 0) %C
%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
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))
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))
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
!----------------------------------------------------------------------------------------------------
!ZZZ
%END; ! OF GPC
%ENDOFFILE