%CONSTSTRING(15) VSN="12 SEP 79 1" ! ! SERVICE NUMBERS FOR SLOW DEVICE ROUTINES ! DEV- ! DEC HEX TYPE ! 48 30 GPC ! 49 31 5 TAPE ! 50 32 8 OPER FOR CTS/CLOCK SCREEN UPDTE, PON X32 1 2/0 ! 51 33 6 PRINTER ADAPTOR ! 52 34 4 SPARE (FORMERLY CARDR) ! 53 35 15 SPARE (FORMERLY LINK) ! 54 36 6 PRINTER ! 55 37 (COMMS CONTROLLER) ! 56 38 (COMMS CONTROLEER) ! 57 39 14 MK1 FE ADAPTOR ! %CONSTBYTEINTEGERARRAY ALLOWCALL(1:15)= %C 0, 0, 0, 0, 49, 54, 0, 50, 0, 0, 0, 0, 0, 57, 53 %CONSTINTEGER MT=5, LP=6, OP=8 %CONSTINTEGER REAL0 SEG=X'2040'; ! PUBLIC 64(DEC) MAPPED TO REAL 0 %CONSTINTEGER ENDLIST=255 %CONSTINTEGER TRUNKADDR=X'40000800' ! !----------------------------------------------------------------------- ! %RECORDFORMAT PARMF(%INTEGER DEST,SRCE,P1,P2,P3,P4,P5,P6) ! ! GPC ROUTINE TO USE TABLE NUMBERS 70 - 79 ! %EXTERNALROUTINESPEC DPON(%RECORDNAME P,%INTEGER SECS) %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 PTREC(%RECORDNAME P) %EXTERNALSTRINGFNSPEC HTOS(%INTEGER I,PL) %EXTERNALSTRINGFNSPEC STRINT(%INTEGER I) %EXTERNALROUTINESPEC PON(%RECORDNAME P) %EXTERNALROUTINESPEC OPMESS(%STRING(63) S) %EXTERNALROUTINESPEC MK1 FE ADAPTOR(%RECORDNAME P) %ROUTINESPEC OPER(%RECORDNAME P) %EXTERNALROUTINESPEC TAPE(%RECORDNAME P) %EXTERNALROUTINESPEC PRINTER(%RECORDNAME P) %SYSTEMROUTINESPEC ITOE(%INTEGER ADDR, LENGTH) %SYSTEMROUTINESPEC ETOI(%INTEGER ADDR, LENGTH) %SYSTEMROUTINESPEC MOVE(%INTEGER LENGTH, FROM, TO) %EXTERNALROUTINESPEC PARSE COM(%INTEGER SRCE, %STRINGNAME S) %EXTRINSICLONGINTEGER KMON ! %RECORDFORMAT SEF(%INTEGER SAW0,SAW1,RESP0,RESP1) %RECORDFORMAT CAF(%INTEGER MARK,PAW,PIW0,PIW1,CSAW0,CSAW1, %C CRESP0,CRESP1,%RECORDARRAY SENTRY(0:15)(SEF));!LENGTH X120 BYTES, SAY ! ! (LENGTH OF COMMS AREA = 8WORDS+15*4 WORDS = 32+240=272(DEC)=X114BYTES ! APPROX) %RECORDFORMAT RCBF(%INTEGER LIMFLAGS,LSTBA,LB BYTES,LBA,AL BYTES, %C ALA,INITWORD,SLOTNO) ! %RECORDFORMAT LBEF(%BYTEINTEGER FLAG0,FLAG1,CMD,PTR) %RECORDFORMAT ALEF(%INTEGER BYTES,ADDR) ! %CONSTINTEGER GPC SNO=48 %CONSTINTEGER GPC DEST=X'00300000' %CONSTINTEGER FREE=0, READY=1, FIRED=2, SENSE FIRED=3, QUEUED=4 %CONSTINTEGER RCB BOUND=X'20' %CONSTINTEGER SLOTSI=32 %CONSTINTEGER ALLOC=1 %CONSTINTEGER SENSING=2 %CONSTINTEGER BUSY=4 %CONSTINTEGER PONR=8 %CONSTINTEGER GETSTRMDATA=16 ! 109876543210 %CONSTINTEGER RQMASK=B'010111111000' %CONSTINTEGER TERMIN=X'00C00000' %CONSTINTEGER ABNORM=X'00400000' %CONSTINTEGER DOSTRMRQ=X'01000000' %CONSTINTEGER DOCTRLLRRQ=X'04000000' %CONSTINTEGER CDE=X'00410000' %CONSTINTEGER TICK INTVL=2; ! SECONDS %CONSTINTEGER PRIVONLY=X'00004000'; ! PRIV VALID %CONSTINTEGER DOCONT=X'04000000' %CONSTINTEGER CINIT=X'32000010' ! CINIT IS THE CONTROLLER INITIALISATION WORD TO BE PUT INTO ! CONTROLLER SAW 0. 3=SAWFLAGS=NO TERMINATION INTERRUPTS ! 2=CONTROLLER INITIALISE ! 10=BYTECOUNT FOR INITIALISATION WORDS ! !------------------------------------------------------------------------ ! FOR EACH MAG TAPE STREAM WE HAVE 8 BYTES IN ARRAY MECHSLOTS. ! MAGINDEX POINTS TO THE DOUBLE-WORD AT WHICH THE ARRAY FOR THIS STREAM ! COMMENCES. !----------------------------------------------------------------------- ! This is a supplementary explanation of "MECHSLOTS" and "MECHINDEX". ! The MECHSLOTS array is a series of groups of 4 (or 8, for MT6) bytes ! containing slot numbers. There is a group of 4 (or 8) for each ! mag tape stream on the system. The contents of the bytes of the group ! are the slot numbers for the mechanisms on the stream. The MECHINDEX ! field in a mag tape slot is the byte offset of the first byte of the ! group from the start of the MECHSLOTS array. ! Thus given any mag tape slot and a mechanism number on the stream to ! which the slot relates,we can find the slot for that mechanism. !----------------------------------------------------------------------- ! %OWNINTEGER MECHPT,NGPCS %OWNINTEGER GPCT BASE,PTSBASE,PTGPCBASE,STRMQBASE,CAASBASE,LASTSLOT ! INDEXED FROM %OWNBYTEINTEGERARRAYNAME PTS TO SLOT; ! 0 TO (HIPT - LOPT)*16 %OWNBYTEINTEGERARRAYNAME PT TO GPC; ! 0 TO (HIPT - LOPT) %OWNBYTEINTEGERARRAYNAME STRMQ; ! 0 TO NGPCS*16-1 BY GPCNO*16+STRM %OWNINTEGERARRAYNAME CAAS; ! 0 TO NGPCS-1 BY GPCNO %OWNBYTEINTEGERARRAYNAME MECHSLOTS; ! 0 TO NTAPESTRMS*8-1 %OWNINTEGER LOPT; ! 0 TO NGPCS-1 BY PT-LOPT %CONSTINTEGER LOID=X'6E' !------------------------------------------------------------------------ ! %OWNBYTEINTEGERARRAYFORMAT BIFT(0:255) %OWNINTEGERARRAYFORMAT IFT(0:1023) %OWNINTEGERARRAYNAME TABLE ! !------------------------------------------------------------------------ %RECORDFORMAT GPCTF(%BYTEINTEGER FLAGS,DEVTYPE,DACT BASE,LINK, %C %INTEGER PROPS0,PROPS1,DEV ENT BASE,CSTATUS,PTSM,MNEMONIC, %C %BYTEINTEGER MECHINDEX,PROPS03,SERVRT,STATE) !------------------------------------------------------------------------ %RECORDFORMAT ENTFORM(%INTEGER %C SER, PTSM, PROPADDR, SECS SINCE, CAA, GRCB AD, LBA, ALA, %C STATE, RESP0, RESP1, SENSE1, SENSE2, SENSE3, SENSE4, %C REPSNO, BASE, ID, DLVN, MNEMONIC, %C ENTSIZE, PAW, USAW0, URCB AD, SENSDAT AD, LOGMASK, TRTAB AD, %C UA SIZE, UA AD, TIMEOUT,PROPS0,PROPS1) !------------------------------------------------------------------------ %ROUTINESPEC PAW NOT CLEARED(%INTEGER PT,STRM) ! %ROUTINE PON GPC INT(%INTEGER PT) %RECORD P(PARMF) P_DEST=GPC DEST ! 3; ! INTERRUPT ENTRY P_P1=PT PON(P) %END; ! PON GPC INT %ROUTINE GET CA(%INTEGER CAA) *LXN_CAA *INCT_(%XNB+0) *JCC_8, SEMALOOP(INTEGER(CAA)) GOT: %END; ! GET CA %ROUTINE SEND CHFLAG(%INTEGER PT) %INTEGER TRUNKADDR TRUNKADDR=X'40000800' ! (PT<<16) *LB_TRUNKADDR *LSS_1 *ST_(0+%B) %END; ! SEND CHFLAG ! GPC MICROPROGRAM VERSION C01 FOLLOWS, IN ARRAY GPCMPROG. %ENDOFLIST %OWNINTEGERARRAY GPCMPROG(0:511)= %C X'F1604820',X'49E04022',X'802BE80A',X'F0C9000A', X'D0098004',X'42659313',X'BE0A1009',X'8004C213', X'CAB38024',X'CA33821C',X'CA53826D',X'CAD38004', X'CA9380BF',X'CA738004',X'CB348004',X'CAF382F2', X'CAD48079',X'8004C273',X'C2D38028',X'8004C2B3', X'820C8209',X'182E92FB',X'80064820',X'E00C740C', X'500B9302',X'B725F9C0',X'F16CDEEB',X'21CCEB4B', X'E00829E8',X'2C8C61CC',X'2CAC61EC',X'4C6B7968', X'B795F9C0',X'0CCC610C',X'FC0061EC',X'FC0070CC', X'08258188',X'80714840',X'0825C2D4',X'CA938049', X'A2D4BC09',X'1004CAD4',X'805ACA73',X'90688004', X'8064CA73',X'80619068',X'A2D4B809',X'A6741004', X'9068F800',X'A2D4B21A',X'A27AA29A',X'82D14989', X'B2F4EA13',X'1013C673',X'20139801',X'91FE9802', X'0835C273',X'8004A2F4',X'4282498C',X'91FE8004', X'A83DA9D4',X'F3ACDCAC',X'200C4BC0',X'700E090C', X'4042B3AC',X'E80E240C',X'5006C006',X'80AD782C', X'B795F9C0',X'A335AED4',X'5017500C',X'0C17C073', X'A9F4F48C',X'501F640E',X'080C500E',X'C873AAF4', X'0D15500C',X'4FE06897',X'2CF512D9',X'EA57E017', X'C27480A7',X'B795F9C0',X'A6731057',X'C83390B7', X'CAF48004',X'406580D5',X'4BE0BC0A',X'10094BC0', X'C883811B',X'93348179',X'E41F111B',X'A150C813', X'A011A2D3',X'9313BA0A',X'F8009801',X'92FBBC0A', X'1009A83D',X'9309782C',X'B795F9C0',X'A7355017', X'500C0C17',X'C073AE93',X'501F9302',X'0D156897', X'2D1512D9',X'C83390B7',X'AB74A273',X'933482D9', X'E0065826',X'EFF45008',X'582632A8',X'2768C014', X'AEF49012',X'ABF25826',X'F177F168',X'FC009197', X'2C37C1A8',X'3C376177',X'0835E40C',X'6908DFEC', X'21735826',X'0CF5501F',X'933482D9',X'E0185826', X'F177AEB4',X'91975826',X'2C37C1DA',X'FC00501F', X'933482D9',X'E4196077',X'A2B4F573',X'F9C0C214', X'81ADC1F4',X'C9D482D9',X'08354291',X'0C06C01F', X'B3B7A314',X'B01DA15D',X'A17DA1B0',X'4D811004', X'09058179',X'DEF3200C',X'EB6CE00C',X'F168DDE3', X'21C84868',X'29E82D4C',X'632C0C2C',X'7B8C0C2C', X'70CC0C0D',X'C00E4D00',X'11760C4C',X'70AC4920', X'F56E1176',X'0C4C70AC',X'0C2570C8',X'81790C2C', X'708C4840',X'81690C2C',X'70AC0C25',X'7AC88144', X'48400C2C',X'790C9204',X'8176640F',X'0815F575', X'11760915',X'0C1FC006',X'92048176',X'5C265004', X'EBA4E004',X'92048176',X'5C269002',X'ABE29204', X'81765C26',X'500DEBAD',X'E01F933A',X'8179E00D', X'9204812A',X'5406500C',X'49C0C00C',X'49E0812A', X'4B209204',X'81764B00',X'C0E38173',X'6E2F0810', X'47161176',X'5E2F5010',X'81714840',X'A500117E', X'484091FE',X'A120A1E0',X'A2E40C07',X'C101DDE3', X'21C04BE0',X'C053A011',X'A3E9A6D3',X'10044840', X'91FEA2E4',X'B160A1E0',X'0C0BC0C0',X'8183EB53', X'2418C01F',X'541F501D',X'EBDD4222',X'9801C0FD', X'9802E00C',X'A8ECDDF3',X'6A8CEF5D',X'200C034C', X'0CB5732C',X'28B5EB5D',X'2418C01F',X'541F501D', X'C8FD9801',X'26D31195',X'0855C9F4',X'827FC9D4', X'82B19190',X'82D90835',X'F16CDCFD',X'21CCC1FD', X'81CFC234',X'82D9292C',X'B67AF9A0',X'F17B0C2C', X'612CFC00',X'6ACC4988',X'42A2A21A',X'4D8F11CA', X'498D09B5',X'A354A233',X'BC0A1009',X'083542A2', X'82D90835',X'282CCA34',X'81DE2CAC',X'628C2C2C', X'62CC2C6C',X'630CFC00',X'634CC0DD',X'81E5A01F', X'A03FB3F7',X'0D7511F9',X'0835EB5D',X'075AC00C', X'C7FD706C',X'C2B482D9',X'2419C00C',X'582C0C55', X'5017500C',X'A774501F',X'933482D9',X'E41F60B7', X'4983A754',X'10102D15',X'12D9EA15',X'E00CDCF5', X'686CE015',X'98012887',X'C0079802',X'08879801', X'B795F9C0',X'8210DE52',X'21D5AB55',X'A375A315', X'A3359068',X'82EE82DB',X'C053A011',X'0C13C1D0', X'A190BA09',X'9801B715',X'F9C0AA33',X'CA5AA2F3', X'CB54824A',X'CB148230',X'C3348237',X'C2D3822B', X'A6331004',X'0855AB34',X'C29A82E8',X'82EE0835', X'AB14923A',X'82D12A35',X'ADB011AD',X'0835A735', X'12EEEA3B',X'E01BF56C',X'689BC09D',X'AA9ADB7A', X'F55DC16C',X'DC6C216C',X'C61A686C',X'CAF49801', X'9802C87D',X'9215AB54',X'923A82D1',X'C09D8257', X'C23AC19D',X'82A3A1D4',X'A69310BF',X'C0BD82CF', X'C23AC19D',X'825EA693',X'10BFEB53',X'E00CCA3A', X'082C0C2C',X'C1D3D9F3',X'1C2C200C',X'034C2D35', X'708C2CB5',X'11B282D9',X'C87D9215',X'AA53C19D', X'8275A1F4',X'A69310BF',X'DDF3200C',X'EB4C0753', X'C00C2DD5',X'708C0CB5',X'12D90833',X'919082D9', X'0895C0DD',X'828BA01F',X'A03FB3F7',X'498B0955', X'A7541010',X'EB5D075A',X'C00CC7FD',X'706CC2B4', X'82D92419',X'C00C582C',X'0C555017',X'500CA774', X'501F9334',X'82D9E41F',X'60B7498B',X'A7541010', X'2D1512D9',X'EB53E00C',X'CA3A082C',X'0C2CC1D3', X'D9F31C2C',X'200C034C',X'2D35786C',X'82D928B5', X'919082D9',X'C87D9215',X'C09D82C6',X'C19D82BC', X'A1D4A693',X'10BFDDF3',X'200CEB4C',X'0753C00C', X'0CB5706C',X'82D90C33',X'12B009D5',X'C0BD82CF', X'C19D82CD',X'A69310BF',X'AE3A125E',X'A51012D3', X'A130A2F4',X'EA3BE411',X'F9000C1A',X'C1B082E0', X'498D91FE',X'CA13820C',X'A2F4A130',X'A1F00C13', X'C1D0C053',X'A011AA73',X'BA09A6D3',X'1010B170', X'0C1AC0F0',X'DCFA21B0',X'82E291FE',X'A170A5F0', X'12D2AAF3',X'CAF48021',X'F17DF17F',X'A334B3D7', X'4D8A1004',X'4BC0740E',X'5008C808',X'98024BE0', X'8801F08C',X'640E080C',X'540E500C',X'4BE09801', X'4043B7AC',X'1310F3AC',X'DCAC200C',X'090CE80E', X'200C9801',X'9309084C',X'540C5006',X'1C4E6866', X'92FB9801',X'6C2C0810',X'640C0811',X'4067E00C', X'540C5006',X'B806640C',X'08069302',X'B809AAD3', X'F170C811',X'4880F171',X'9803229F',X'283FA81F', X'D83F0915',X'9802EA37',X'E017C43D',X'62B74137', X'413AEFB4',X'787FEBA4',X'083507BF',X'C008EFBF', X'60A8E408',X'70889801',X'E0080835',X'A808DFC8', X'2008EE92',X'787FEA82',X'20085C28',X'500C5008', X'EE3F900B',X'C374835B',X'DEEC787D',X'DB6CE008', X'EB740368',X'B7087868',X'98010835',X'3828F0CC', X'AA94C82C',X'A294EA3F',X'2637C008',X'2828C9A8', X'9801EA28',X'022CAFEB',X'786C9801',X'0835C06B', X'8378C02B',X'9801A3EB',X'540B900B',X'83700835', X'CA948388',X'C02B9801',X'EA3FC83D',X'EA28E01F', X'B34C382C',X'F1EBD83F',X'0875328B',X'98020835', X'40632855',X'C02B9801',X'0875E81F',X'C83DE008', X'B2AC382C',X'F07FEA37',X'241FC00C',X'ABEBF17E', X'DD2821DE',X'EA8B201E',X'282CF168',X'DD2C21C8', X'D9282017',X'B108E808',X'0017B2A8',X'E808000C', X'FC00716C',X'583EC03D',X'285E040C',X'9016C036', X'9801FC00',X'7ACC541E',X'9008C028',X'9801C817', X'83BD085E',X'C83D289E',X'200CB12B',X'E80B0017', X'EA88E008',X'A048D82C',X'C03DD83F',X'32C80835', X'98020000',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'00000000',X'00000000',X'00000000', X'00000000',X'00000000',X'00000000',X'0000F2B2', X'B80AA213',X'498D9800',X'0C010000',X'1585B27F' %LIST ! %EXTERNALINTEGERFN GPC INIT(%INTEGER CA VA,PT,CHOPSUPE) ! ! RESULT=0 OK ! 1<<24 ! CRESP0 MICROPROGRAM LOAD FAILED ! 2<<24 ! CRESP0 INITIALISE FAILED, RESPONSE FROM OLD COMMS AREA ! 3<<24 ! CRESP0 DITTO, RESPONSE FROM NEW COMMS AREA ! ! Parameter CHOPSUPE is set 1 when this function is being called from ! GPC GROPE, else zero. The only effects of CHOPSUPE being non-zero are: ! (a) slaves switched off, then on ! (b) controller responses saved in main store, real address X2000, ! instead of DUMP TABLEs being done. ! %RECORDFORMAT INIF(%INTEGER MAXAD,PSTRA,CA VA,SOE) %OWNRECORD INI(INIF) ! %RECORDFORMAT SEF(%INTEGER SAW0,SAW1,RESP0,RESP1) %RECORDFORMAT CA0F(%INTEGER MARK,PAW,PIW0,PIW1,CSAW0,CSAW1, %C CRESP0,CRESP1); ! LENGTH X20 BYTES %RECORDFORMAT CAF(%INTEGER MARK,PAW,PIW0,PIW1,CSAW0,CSAW1, %C CRESP0,CRESP1,%RECORDARRAY SENTRY(0:15)(SEF));!LENGTH X120 BYTES %RECORDNAME CA0(CA0F) %RECORDNAME CA(CAF) ! %INTEGER PSTLIM,PSTRA %INTEGER TRUNKADDR %INTEGER J,RA0AD,SAVERA0,SAVERA1,CT ! %OWNINTEGER RECAT=0 ! TRUNKADDR=X'40000800' ! (PT<<16) ! MASTER CLEAR GPC *LSS_2 *LB_TRUNKADDR *ST_(0+%B) WAIT(50); ! MILLISECONDS ! ! SAVE FIRST TWO WORDS OF REAL STORE FOR PETE RA0AD=REAL0 SEG<<18 SAVERA0=INTEGER(RA0AD) SAVERA1=INTEGER(RA0AD+4) ! %IF CHOPSUPE#0 %THEN SLAVESONOFF(0); ! SLAVES OFF CA0==RECORD(REAL0 SEG<<18); ! INITIAL COMMS AREA ! ! FIRST LOAD THE GPC MICROPROGRAM CA0=0 CA0_PAW=X'08000000'; ! PAW FN 08 IS LOAD MICROPROG ! THE ORIGINAL BOOTSTRAP DOES CA0_CSAW0=X'1000', ALTHOUGH THE GPC ! TECHNICAL DESCRIPTION 1112732 SHEET 13 SAYS ONLY CSAW1 IS RELEVANT FOR ! THIS FUNCTION CA0_CSAW1=REALISE(ADDR(GPCMPROG(0))); ! REAL ADDRESS CA0_MARK=-1 SEND CHFLAG(PT) CT=0 %UNTIL (CA0_CRESP0#0 %AND CA0_MARK=-1) %OR CT>300000 %THEN CT=CT+1 %IF CA0_CRESP0 & X'00800000'=0 %START ! TERMINATION WAS NOT NORMAL %RESULT=(1<<24) ! CA0_CRESP0; ! MICROPROGRAM LOAD FAILED %FINISH WAIT(50); ! MILLISECONDS ! ! WE NEED TO INITIALISE THE GPC GIVING PST REAL ADDRESS AND LIMIT. ! CA0=0 SEND CHFLAG(PT); ! TO INITIALISE THE CONTROLLER ! IMAGE STORE INSTRUCTIONS CAN SPOIL LOW REAL ADDRESS WORDS, SO ! CLEAR AREA AGAIN CA0=0 CA0_PAW=DOCONT CA0_CSAW0=CINIT CA0_CSAW1=REALISE(ADDR(INI)) ! GET PSTB(PSTLIM,PSTRA) INI_MAXAD=PSTLIM INI_PSTRA=PSTRA INI_CA VA=CA VA INI_SOE=0 ! ! INITIALISE THE NEW COMMS AREA CA==RECORD(CA VA) CA=0 CA_MARK=-1 %IF CHOPSUPE#0 %START RECAT=RA0AD+X'2000' %IF RECAT=0 %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 CA0_MARK=-1; ! FREE COMMS AREA AND LET CONTROLLER DO THE JOB CT=0 %UNTIL (CA_CRESP0#0 %AND CA_MARK=-1) %OR CT>900000 %THEN CT=CT+1 ! (leave slaves alone in chopsupe) %IF CHOPSUPE=0 %START ! Called from GPC SLAVESONOFF(-1); ! SLAVES ON AGAIN DUMP TABLE(2,REAL0SEG<<18,X'400') DUMP TABLE(3,CA VA,X'400') DUMP TABLE(4,ADDR(INI),64) %FINISH %IF CA_CRESP0<<8 >=0 %START %IF CA_CRESP0=0 %THEN %RESULT=(2<<24) ! CA0_CRESP0 %RESULT=(3<<24) ! CA_CRESP0; ! INITIALISE FAILED %FINISH CA_CRESP0=0 CA_MARK=-1 ! PUT BACK THE FIRST TWO WORDS OF REAL STORE FOR PETE INTEGER(RA0AD)=SAVERA0 INTEGER(RA0AD+4)=SAVERA1 %RESULT=0; ! SUCCESS %END; ! GPC INIT %ROUTINESPEC CONNECT STREAMS(%INTEGER PT,CAA,STRM PARAM,DISCO) %INTEGERFN READ STRM DATA(%INTEGER PT,STRM,CONTROLLER STATUS) ! This routine does a READ STREAM DATA controller command (for param CONTROLLER = 0) ! obtaining 64 bytes of stream data, or a READ STREAM'S CONTROLLER STATUS ! controller command (for param CONTROLLER STATUS = 1) obtaining 4 bytes ! of status data. %INTEGER CAA,SAWFLAGS,BREG,J,GPCNO,CONTROLLER CMD,LEN %RECORDNAME CA(CAF) %INTEGERARRAY STRM DATA(0:63) PRINTSTRING("READ STREAM DATA PTS ".HTOS(PT<<4!STRM,3)) NEWLINE LEN=64 CONTROLLER CMD=X'07'; ! READ STREAM DATA command %IF CONTROLLER STATUS#0 %START LEN=4 CONTROLLER CMD=X'03'; ! READ STREAM'S CONTROLLER STATUS command %FINISH GPCNO=PT TO GPC(PT - LOPT) CAA=CAAS(GPCNO) CA==RECORD(CAA) %IF CA_PAW#0 %THEN PAW NOT CLEARED(PT,-1) SLAVESONOFF(0); ! SLAVES OFF *LXN_CAA *INCT_(%XNB+0) *JCC_8, SEMALOOP(CA_MARK) GOT30: ! GOT SEMA CA_CRESP0=0 SAWFLAGS=3; ! CLEAR ABN., INHIBIT TERM INTERRUPT CA_PAW=DOCTRLLRRQ CA_CSAW0=SAWFLAGS<<28 ! CONTROLLER CMD<<24 ! STRM<<16 ! LEN CA_CSAW1=ADDR(STRM DATA(0)) ! FREE SEMA AND SEND CHANNEL FLAG BREG=TRUNKADDR ! (PT<<16) CA_MARK=-1 *LB_BREG *LSS_1 *ST_(0+%B) !LOOP AWAITING RESPONSE J=0 %UNTIL CA_CRESP0#0 %OR J>100000 %THEN J=J+1 SLAVESONOFF(-1); ! SLAVES ON AGAIN DUMP TABLE(79,ADDR(STRM DATA(0)),LEN) PRINTSTRING("CRESP0=".HTOS(CA_CRESP0,8)) NEWLINE ! Result useful only on the case of the READ STREAM'S CONTROLLER STATUS command %RESULT=STRM DATA(0) %END; ! READ STRM DATA %ROUTINE CONNECT STREAMS(%INTEGER PT,CAA,STRM PARAM,DISCO) ! This routine disconnects, then re-connects one or all stream(s) on a ! port-trunk (GPC), giving abterms for relevant streams which are currently ! busy. If parameter DISCO is non-zero, the call is to disconnect and not ! to re-connect. ! STRM PARAM: -1 all streams ! >=0 that stream %CONSTINTEGER SUCCESS BIT=X'00800000' %OWNINTEGER DUMMY WORD %OWNINTEGER DISCONNECT LBE=X'00F10900' %OWNINTEGER CONNECT LBE=X'00F10800' %OWNRECORD ALE(ALEF) %OWNRECORD RCB(RCBF) %INTEGER LO,HI,STRM,CT,FAILS,PAW FAILS,J %RECORDNAME CA(CAF) %RECORDNAME GPCT(GPCTF) %RECORDNAME SENT(SEF) PRINTSTRING("CONNECT STREAMS ".HTOS(PT,2)) WRITE(STRM PARAM,1) NEWLINE ALE_BYTES=4; ALE_ADDR=ADDR(DUMMY WORD) RCB_LIMFLAGS=PRIVONLY RCB_LB BYTES=4 RCB_LBA=ADDR(DISCONNECT LBE) RCB_AL BYTES=8 RCB_ALA=ADDR(ALE) CA==RECORD(CAA) FAILS=0; PAW FAILS=0 SLAVESONOFF(0); ! SLAVES OFF %IF STRM PARAM=-1 %THEN LO=0 %AND HI=14 %ELSE %C LO=STRM PARAM %AND HI=STRM PARAM ! First disconnect the stream(s) %CYCLE STRM=LO,1,HI SENT==CA_SENTRY(STRM) *LXN_CAA *INCT_(%XNB+0) *JCC_8, SEMALOOP(CA_MARK) GOT41: CA_PAW=DOSTRMRQ ! STRM SENT=0 SENT_SAW0=X'30000020'; ! SAW FLAGS + RCB BOUND SENT_SAW1=ADDR(RCB) CA_MARK=-1 SEND CHFLAG(PT) CT=0 %UNTIL SENT_RESP0#0 %OR CT>100000 %THEN CT=CT+1 %IF SENT_RESP0&SUCCESS BIT=0 %START PRINTSTRING("DISCONN STRM ".HTOS(STRM,1)." RESP0=".HTOS( %C SENT_RESP0,8)) NEWLINE %FINISH %IF CA_PAW#0 %THEN PAW FAILS=PAW FAILS+1 %REPEAT %IF DISCO=0 %START ! Then re-connect the stream(s). ! This delay is for the front end, in particular, so that the ! XOP line is down after a disconnect for long enough ! for the front end to sort itself out. WAIT(10); ! milliseconds RCB_LBA=ADDR(CONNECT LBE) %CYCLE STRM=LO,1,HI SENT==CA_SENTRY(STRM) *LXN_CAA *INCT_(%XNB+0) *JCC_8, SEMALOOP(CA_MARK) GOT42: CA_PAW=DOSTRMRQ ! STRM SENT=0 SENT_SAW0=X'30000020'; ! SAW FLAGS + RCB BOUND SENT_SAW1=ADDR(RCB) CA_MARK=-1 SEND CHFLAG(PT) CT=0 %UNTIL SENT_RESP0#0 %OR CT>100000 %THEN CT=CT+1 %IF SENT_RESP0&SUCCESS BIT=0 %START FAILS=FAILS+1 PRINTSTRING("CONN STRM ".HTOS(STRM,1)." RESP0=".HTOS( %C SENT_RESP0,8)) %FINISH %IF CA_PAW#0 %THEN PAW FAILS=PAW FAILS+1 ! CLEAR THE RESPONSE WORD - WE DO NOT RECKON WE NEED THE SEMAPHORE SENT_RESP0=0 %REPEAT %FINISH; ! DISCO = 0 SLAVESONOFF(-1); ! SLAVES ON AGAIN PRINTSTRING("SAW FAILS/PAW FAILS=") WRITE(FAILS,1); WRITE(PAW FAILS,1) NEWLINE ! Give a special abnormal termination response for each relevant stream ! which was busy. For a single-stream re-connect, just that stream, else ! all streams if the GPC has been re-initialised. *LXN_CAA *INCT_(%XNB+0) *JCC_8, SEMALOOP(CA_MARK) GOT40: J=0 %WHILE J<=LASTSLOT %CYCLE GPCT==RECORD(GPCTBASE + J*SLOTSI) STRM=(GPCT_PTSM>>4)&15 %IF (GPCT_PTSM>>8)&255=PT %AND %C GPCT_FLAGS&BUSY#0 %AND %C (STRM=STRM PARAM %OR STRM PARAM<0) %START PRINTSTRING("ABTERM GENERATED GPTSM ".HTOS(GPCT_PTSM,5)) NEWLINE CA_PIW0=CA_PIW0 ! (X'80000000'>>STRM) ! Place time-out indication in the stream entry SENT_RESP0=ABNORM SENT_RESP1=-1; ! time-out indication to user %FINISH J=J+1 %REPEAT CA_MARK=-1 PON GPC INT(PT) WAIT(100); ! milliseconds %END; ! CONNECT STREAMS !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ %OWNINTEGER GPCDUMPING=0 %ROUTINE GPC DUMP(%INTEGER PT) %INTEGER CAA,J,GPCNO %OWNINTEGER TIMES DUMPED=0 %RETURN %IF TIMES DUMPED>10 GPCDUMPING=1 TIMES DUMPED=TIMES DUMPED + 1 CONTROLLER DUMP(3,PT) GPCNO=PT TO GPC(PT - LOPT) CAA=CAAS(GPCNO) J=GPC INIT(CAA,PT,0) PRINTSTRING("GPC RE-INIT RESULT = ".HTOS(J,8)) NEWLINE CONNECT STREAMS(PT,CAA,-1,0) GPCDUMPING=0 %END; ! GPC DUMP %ROUTINE PAW NOT CLEARED(%INTEGER PT,STRM) ! This routine is called when PAW or a SAW has been found non-zero when ! a channel flag is about to be issued. If STRM is negative, SAW is not ! relevant. ! This routine ! waits a bit ! send channel flag "again" if PAW still non-zero ! waits a bit ! does a GPC-dump if PAW (or SAW if STRM>=0) still non-zero %INTEGER CAA,GPCNO,BREG,J %RECORDNAME CA(CAF) %RECORDNAME SENT(SEF) PRINTSTRING("PAW NOT CLEARED PT ".HTOS(PT,2)) NEWLINE GPCNO=PT TO GPC(PT - LOPT) CAA=CAAS(GPCNO) CA==RECORD(CAA) SLAVESONOFF(0); ! SLAVES OFF %IF CA_PAW#0 %THEN WAIT(100) %IF CA_PAW#0 %START BREG=TRUNKADDR ! (PT<<16) *LB_BREG *LSS_1 *ST_(0+%B); ! SEND CHANNEL FLAG WAIT(100) %FINISH SLAVESONOFF(-1); ! SLAVES ON AGAIN J=0 %IF STRM>=0 %THEN SENT==CA_SENTRY(STRM) %AND J=SENT_SAW0 %IF J#0 %START PRINTSTRING("SAW NOT CLEARED STRM") WRITE(STRM,1); NEWLINE %FINISH %IF CA_PAW#0 %OR J#0 %THEN GPC DUMP(PT) %END; ! PAW NOT CLEARED %STRINGFN MNS(%RECORDNAME D) %RECORDSPEC D(ENTFORM) %INTEGER I I=D_MNEMONIC BYTEINTEGER(ADDR(I))=3 %RESULT=STRING(ADDR(I)) %END; ! MNS %EXTERNALROUTINE GPC(%RECORDNAME INP) %RECORDSPEC INP(PARMF) %INTEGER DSNO,DACT,FLAG,CAA,SLOT,PAWFN,SAWFLAGS,URCB AD,USAW0 %INTEGER LAST,MECH,STRM,GPCNO,BREG,PIW0 %INTEGER J,PT,RESP0,RESP1,OSNO,PREVIOUS PT %INTEGER SRCE,CALLED,SENSFLAGS,TYPE,ABN STRM DATA %INTEGER GMON %STRING(31) WK %RECORD P(PARMF) ! %OWNINTEGER SETUP=0 ! %BYTEINTEGERNAME QHD ! %INTEGERFNSPEC FIND(%INTEGER INF) %ROUTINESPEC DO MAPPINGS %ROUTINESPEC RESPOND(%RECORDNAME GPCT,%INTEGER ACT,RESP0,RESP1,SENSFL) %INTEGERFNSPEC INT WAITING(%INTEGER RESP0,%INTEGERNAME SLOT) %SWITCH INTS(0:7) %SWITCH GS(3:11) ! %RECORDNAME D(ENTFORM) %RECORDNAME CA(CAF) %RECORDNAME SENT(SEF) %RECORDNAME GPCT,GE(GPCTF) %RECORDNAME RCB(RCBF) ! P=INP GMON<-(KMON>>GPC SNO)&1 %IF GMON#0 %THEN PRINTSTRING("GPC( IN):") %AND PTREC(P) %IF SETUP=0 %START ! ! THROW AWAY MSGS (EG. SPURIOUS INTERRUPT ENTRIES) BEFORE THE ! INITIALISATION MSG, WHICH HAS DACT=2 %RETURN %UNLESS P_DEST&X'FFFF'=2 SETUP=1 J=P_P1; ! ADDRESS OF TABLE CONTAINING TABLES TABLE==ARRAY(J,IFT) GPCTBASE=J+TABLE(1)<<2 LASTSLOT=TABLE(2) NGPCS=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) 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) J=0 ! RE-INITIALISE SLOTS %WHILE J<=LASTSLOT %CYCLE GPCT==RECORD(GPCTBASE + J*SLOTSI) GPCT_FLAGS=GPCT_FLAGS & (\(ALLOC!BUSY!PONR)) GPCT_SERVRT=0 GPCT_LINK=ENDLIST J=J+1 %REPEAT ! RE-INITIALISE STREAM Q HEADS J=0 %WHILE J>4)<<8) P_SRCE=X'80300000' OPER(P) %FINISH ! New TAPE arrangements from 579. One TAPE call per cluster ! (i.e. PTS). P_P1 = low mnemonic for the PTS. %IF GE_DEVTYPE=MT %START PT=(GE_PTSM>>4) & X'FFF'; ! holds PTS really %IF PREVIOUS PT#PT %START P=0 P_DEST=X'00310004' P_P1=GE_MNEMONIC; ! RH char must be and should be zero P_P3=CAAS(0)+TABLE(40); ! VIRTUAL ADDRES OF AREA FOR TAPE REQUEST QUEUING (02 FEB 79) P_P4=TABLE(41); ! length in bytes of that area ! TAPE(P) PREVIOUS PT=PT %FINISH %FINISH; ! DEVTYPE MT J=J+1 %REPEAT PRINTSTRING("GPC VSN ".VSN) NEWLINE P_DEST=X'A0001'; ! INTERVAL TIMER P_SRCE=1<<31 P_P1=GPC DEST + 6 P_P2=TICK INTVL PON(P) -> OUT %FINISH ! CONVENTIONS VIS A VIS CALLING/PONNING ARE AS FOLLOWS: ! DEST TO BE ALWAYS SET UP APPROPRIATELY ! SRCE TO BE SET TO OWN SNO. ! IN ADDITION, TOP BIT TO BE SET IN SRCE IF CALLING RATHER THAN ! PONNING (OR NO REPLY REQUIRED). ! DSNO=P_DEST>>16 DACT=P_DEST&X'FFFF' SRCE=P_SRCE CALLED=SRCE>>31; ! SET #0 IF MSG WAS CALLED, ZERO IF PONNED SRCE=(SRCE<<1)>>1; ! REMOVE TOP BIT FLAG=1 %UNLESS (1< FAIL -> GS(DACT) ! GS(4): ! ALLOCATE -> FAIL %IF FIND(P_P1)<0; ! MNEMONIC IN P1 FLAG=2 -> FAIL %IF GPCT_FLAGS&ALLOC#0; ! ALREADY ALLOC ! P2 TO CONTAIN 0 IF CALL WANTED WITH RESPONSES ! 1 IF RESPONSES TO BE PONNED GPCT_SERVRT<-SRCE>>16 ! THE SECOND CONDITION BELOW IS INTENDED TO ALLOW ONLY THE KNOWN ! SERVICE ROUTINES (AS DEFINED BY THE ARRAY ALLOWCALL) TO BE CALLED ! WITH RESPONSES. OTHERWISE, IF A DEVICE IS ALLOCATED TO A DIFFERENT SERVICE ! ROUTINE, THE ORIGINAL KNOWN ONE GETS CALLED WITH RESPONSES, WHICH IS ! NO GOOD. %IF P_P2#0 %OR ALLOWCALL(GPCT_DEVTYPE)#GPCT_SERVRT %C %THEN GPCT_FLAGS=GPCT_FLAGS ! PONR GPCT_FLAGS=GPCT_FLAGS ! ALLOC ! P_P2=LOID + SLOT; ! DEVICE SERVICE NO P_P3=ADDR(D) P_P4=0; ! REQD TEMP FOR COMPT WITH "RESTART" ! IN ADDITION FOR AN OPER STREAM, SUPPLY ! P3 = BUFFER AREA ADDRESS ! P4 = LAST BYTE OF PROPERTY CODES (GIVING NO. OF SCREENS) ! P5 = AREA SIZE IN BYTES (FOR CHECKING PURPOSES) %IF GPCT_DEVTYPE=OP %START ! 32 IS THE TABLE ENTRY AT WHICH OPER BUFFER POINTERS START OSNO=32+GPCT_MECHINDEX>>4; ! 32+ 'LOGICAL' NUMBER OF THIS OPER STREAM P_P3=CAA+TABLE(OSNO)>>16 P_P4=GPCT_MECHINDEX&15 P_P5=TABLE(OSNO) & X'FFFF' %FINISH P_P6=GPCT_MNEMONIC; ! REALLY FOR MAIN LP CLAIM, SPECIAL M'LP' -> REPLY OK ! GS(5): ! DE-ALLOC -> FAIL %IF P_P1=M'LP' %OR FIND(P_P1)<0; ! EXCLUDE THIS FUNNY MAIN LP CASE P_P3=ADDR(D) FLAG=2 -> FAIL %IF GPCT_FLAGS&ALLOC=0; ! NOT ALLOC GPCT_SERVRT=0 GPCT_FLAGS=GPCT_FLAGS&(\(ALLOC!PONR!BUSY)) -> REPLY OK ! GS(8): ! FRIG FE0 TIMEOUT TO 5 SECONDS J=FIND(M'FE0') %IF J>=0 %START ! OK, TAKE P_P1 VALUE, BUT 5 IN DEFAULT.. J=P_P1 %IF J<5 %THEN J=5 D_TIMEOUT=J OPMESS("GPC:OK") %FINISH -> OUT !------------------------------------------------------------------------ GS(6): ! CLOCK INTERRUPT PREVIOUS PT=0 ! We are going to check the PIW for each port-trunk, and pon a GPC ! interrupt entry if it's non-zero, in case an interrupt has been lost J=0 %WHILE J<=LASTSLOT %CYCLE GE==RECORD(GPCTBASE + J*SLOTSI) D==RECORD(GE_DEV ENT BASE) PT=(GE_PTSM>>8)&255 CAA=D_CAA CA==RECORD(CAA) %IF PT#PREVIOUS PT %AND CA_PIW0#0 %THEN PON GPC INT(PT) %C %AND PREVIOUS PT=PT %IF GE_FLAGS&BUSY#0 %THEN %C D_SECS SINCE=D_SECS SINCE + TICK INTVL %IF D_SECS SINCE>D_TIMEOUT %START WK="GPC TIMEOUT ".MNS(D)." ".HTOS(PT,2) PRINTSTRING(WK); NEWLINE OPMESS(WK) STRM=(GE_PTSM>>4)&15 J=READ STRM DATA(PT,STRM,0) RCB==RECORD(D_URCB AD) PRINTSTRING("COMMS AREA: ") DUMP TABLE(70,CAA,512) PRINTSTRING("SLOTS: ") DUMP TABLE(70,GPCT BASE,(LASTSLOT+1)*SLOTSI) PRINTSTRING("DEVICE ENTRY: ") DUMP TABLE(70,ADDR(D),ADDR(D_PROPS1)-ADDR(D)+4) PRINTSTRING("LOGIC BLOCKS: ") DUMP TABLE(70,RCB_LBA, RCB_LB BYTES) %IF RCB_LBA<0; ! not local areas PRINTSTRING("ACTIVE RCB: ") DUMP TABLE(70,D_URCB AD,256) %IF D_URCB AD<0; ! not local areas PRINTSTRING("ADDRESS LIST: ") DUMP TABLE(70,RCB_ALA,RCB_AL BYTES) %IF RCB_ALA<0; ! not local areas PRINTSTRING("AREAS POINTED TO BY AL: ") J=0 %WHILE J SEMALOOP(CA_MARK) GOT5: CA_PAW=3<<24 ! STRM; ! STOP STREAM BREG=TRUNKADDR ! (PT<<16) CA_MARK=-1 *LB_BREG *LSS_1 *ST_(0+%B) WAIT(50) CONNECT STREAMS(PT,CAA,STRM,0) D_SECS SINCE=0 %FINISH J=J+1 %REPEAT -> OUT GS(7): ! DISCONNECT OR RE-CONNECT A STREAM ! P1 = mnemonic for (one of the) device(s) ! P2 = 0 disconnect stream ! P2 = 1 re-connect stream J=P_P1 %IF FIND(J)<0 %START J=J<<8>>8 ! (3<<24) OPMESS("NO ".STRING(ADDR(J))) -> OUT %FINISH CONNECT STREAMS(PT,CAA,STRM,1-P_P2) -> OUT !------------------------------------------------------------------------ GS(10): ! EXECUTE CHAIN ! P1=RCB ADDRESS ! P2=SNO FOR DEVICE ! P3=READ STRM DATA ON ABN<<8 ! PAW FN<<4 ! SAWFLAGS ! P4=CALLER'S ID ! The READ STRM DATA ON ABN quartet indicates whether to do a READ STREAM'S ! CONTROLLER STATUS controller command on abnormal termination. This will ! not normally be required, but the facility has been created (JUNE 79) for ! the Engineers' test package TCSS. ! REPLY FLAGS IN P1 ! 1 INVALID SNO FOR DEVICE OR NOT ALLOCATED ! 2 SLOT BUSY ! 3 SPARE ! 4 SPARE ! 5 PAW ERROR (PAW NOT CLEAR) ! 6 SAW ERROR (SAW NOT CLEAR) URCB AD=P_P1 SLOT=P_P2 - LOID -> FAIL %UNLESS 0<=SLOT<=LASTSLOT %AND GPCDUMPING=0 DO MAPPINGS ABN STRM DATA=P_P3>>8 PAW FN=(P_P3>>4) & 15 SAWFLAGS=P_P3&15 D_ID=P_P4 P_P3=ADDR(D); ! for the reply -> FAIL %IF GPCT_FLAGS&ALLOC=0; ! NOT ALLOCATED FLAG=2 ! (ALLOW 'STOP STREAM', PAW FN 3) %IF GPCT_FLAGS&BUSY#0 %AND PAWFN#3 %THEN -> FAIL %IF ABN STRM DATA=0 %THEN GPCT_FLAGS=GPCT_FLAGS&(\GETSTRMDATA) %C %ELSE GPCT_FLAGS=GPCT_FLAGS ! GETSTRMDATA USAW0=(SAWFLAGS<<28) ! RCB BOUND D_USAW0=USAW0 D_URCB AD=URCB AD D_PAW=(PAWFN<<24) ! STRM D_RESP1=0; ! TO CANCEL POSSIBLE TIMEOUT INDICATION ! %IF QHD=ENDLIST %START ! STREAM IS IDLE - ISSUE REQUEST RIGHT AWAY %IF CA_PAW#0 %OR SENT_SAW0#0 %THEN PAW NOT CLEARED(PT,STRM) *LXN_CAA *INCT_(%XNB+0) *JCC_8, SEMALOOP(CA_MARK) GOT1: CA_PAW=D_PAW ! STICK ON BUSY LIST AND SET ENDLIST IN SLOT GPCT_LINK=ENDLIST QHD=SLOT SENT_SAW0=USAW0; ! SAW FLAGS + RCB BOUND SENT_SAW1=URCB AD ! FREE COMMS AREA SEMAPHORE AND SEND CHANNEL FLAG BREG=TRUNKADDR ! (PT<<16) CA_MARK=-1 *LB_BREG *LSS_1 *ST_(0+%B) GPCT_FLAGS=GPCT_FLAGS ! BUSY D_SECS SINCE=0 %FINISH %ELSE %START; ! ------------------------------------------- ! STREAM IS BUSY - Q THE REQUEST AT THE END OF THE CHAIN POINTED TO BY STRMQ(STRM). ! LINKS ARE ALL SLOT NUMBERS. !++MULTI-PROCESSOR, GET SEMAPHORE FOR(THIS STREAM ON THIS GPC) LAST=QHD %UNTIL LAST=ENDLIST %CYCLE GE==RECORD(GPCT BASE + LAST*SLOTSI) LAST=GE_LINK %REPEAT GE_LINK=SLOT GPCT_LINK=ENDLIST !++FREE SEMA %FINISH -> REPLY OK ! !------------------------------------------------------------------------ GS(3): ! INTERRUPT RECEIVED P_P1 HAS PORT & TRUNK (X'000000PT') PT=P_P1 ! SELECT CORRECT COMMS AREA GPCNO=PT TO GPC(PT - LOPT) CAA=CAAS(GPCNO) CA==RECORD(CAA) ! FIRST ITEM OF STRMQ(STRM) LIST IS THE SLOT CURRENTLY BUSY INTS(0): MORE INTS: *LXN_CAA *INCT_(%XNB+0) *JCC_8, SEMALOOP(CA_MARK) GOT2: *LSS_(%XNB+2); *ST_PIW0 *JAT_4, *SHZ_STRM; ! FIND INTERRUPTING STREAM SENT==CA_SENTRY(STRM) RESP0=SENT_RESP0 RESP1=SENT_RESP1 SENT_RESP0=0 SENT_RESP1=0 CA_PIW0=PIW0 !! X'80000000'>>STRM CA_MARK=-1 TYPE=INT WAITING(RESP0,SLOT) DO MAPPINGS -> INTS(TYPE) INTS(1): ! ATTENTION RESPONSE RESPOND(GPCT,3,RESP0,0,0) -> MORE INTS ! INTS(2): ! TERMINATION RESPONSE ----------------------- ! SLOT STATES ARE ! 0 NOT ALLOCATED (FREE) ! 1 READY ! 2 REQUEST FIRED ! 3 SENSE FIRED ! 4 SLOT QUEUED %IF RESP0&TERMIN#0 %START %IF GPCT_FLAGS&SENSING#0 %OR D_RESP1=-1 %START ! WAS SENSING, OR WAS GIVEN A TIME-OUT RESPONSE. ! IF THIS IS A REPLY TO A GPC-RT-INITIATED ! SENSE, THEN BIT SENSING IS SET IN FLAGS. ! IN THIS CASE WE ARE THROUGH AND WE REPLY ! TO CALLER WITH SECONDARY AND TERTIARY STATUS. SENSFLAGS=RESP0>>16; ! ANALY FLAGS FROM SENSE ! THE SCHEME HERE IS THAT WE 'AND' THE LOGMASK FIELD (BOTTOM BYTE) ! AND THE SECONDARY STATUS, AND DUMP TABLE IF NON-ZERO. %IF D_LOGMASK&BYTEINTEGER(ADDR(D_SENSE1))#0 %THEN %C DUMP TABLE(70+GPCT_DEVTYPE,ADDR(D),D_ENTSIZE) ! ALSO PASS BACK ANALYSIS FLAGS FOR THE SENSE GPCT_FLAGS=GPCT_FLAGS & (\(SENSING!BUSY)) !++MULTI-PROCESSOR, GET SEMAPHORE FOR(THIS STREAM ON THIS GPC) QHD=GPCT_LINK; ! DROP SLOT GPCT_LINK=ENDLIST !++FREE SEMA RESPOND(GPCT,5,D_RESP0,D_RESP1,SENSFLAGS) -> TRY NEXT %FINISH %IF RESP0&ABNORM#0 %START ! LEAVE SLOT AS FIRST IN LIST AND ISSUE SENSE D_RESP0=RESP0 D_RESP1=RESP1 %UNLESS D_RESP1=-1 ! ABNORMAL TERMINATION DISCOVERED ABOVE ! STORE CURRENT RESPONSE AND ISSUE SENSE J=D_LOGMASK>>8 %IF RESP0&X'00FF0000'=CDE %OR J#0 %START %IF RESP0&X'00FF0000'=CDE %THEN WK="CDE ".MNS(D) %C ." PT ".HTOS(PT,2) %C %ELSE WK="FE ABTERM PT ".HTOS(PT,2) PRINTSTRING(WK); NEWLINE OPMESS(WK) J=READ STRM DATA(PT,STRM,0) %FINISH %IF GPCT_FLAGS&GETSTRMDATA#0 %THEN GPCT_CSTATUS= %C READ STRM DATA(PT,STRM,1); ! READ STREAM'S CONTROLLER STATUS %IF CA_PAW#0 %THEN PAW NOT CLEARED(PT,STRM) *LXN_CAA *INCT_(%XNB+0) *JCC_8, SEMALOOP(CA_MARK) GOT3: CA_PAW=DOSTRMRQ ! STRM SENT_SAW0=X'10000020'; ! INTS + RCB BOUND SENT_SAW1=D_GRCB AD ! DO NOT SEND AN INIT WORD (IN THE CASE OF MT WE ARE ADDRESSING THE MECHANISM ALREADY SELECTED) BREG=TRUNKADDR ! (PT<<16) CA_MARK=-1 *LB_BREG *LSS_1 *ST_(0+%B) GPCT_FLAGS=GPCT_FLAGS ! BUSY ! SENSING -> MORE INTS %FINISH !-------------- THEN NORMAL TERMINATION --------------------- D_RESP0=RESP0 D_RESP1=RESP1 GPCT_FLAGS=GPCT_FLAGS & (\BUSY) !++MULTI-PROCESSOR, GET SEMAPHORE FOR(THIS STREAM ON THIS GPC) QHD=GPCT_LINK; ! DROP SLOT GPCT_LINK=ENDLIST !++FREE SEMA RESPOND(GPCT,2,RESP0,RESP1,0) %FINISH TRY NEXT: ! NOW WE LOOK TO SEE IF WE CAN START A REQUEST ON A STREAM FOR ! WHICH A SLOT HAS JUST BEEN DROPPED. THE HEAD OF THE STREAMQ IS READY TO ! GO IF BUSY IS NOT SET. (BUSY IS SET IF THE HD IS THE SLOT LAST FIRED ! AND TERMINATION HAS NOT YET BEEN RECEIVED). THIS QUEUING BUSINESS IS ! ALL NECESSARY ONLY BECAUSE OF MAG TAPES - MULTIPLE MECHANISMS ON ! ONE STREAM. QHD ALREADY IS MAPPED TO THE STRMQ ENTRY FOR THE STREAM ! JUST TERMINATED. %IF QHD#ENDLIST %START GPCT==RECORD(GPCT BASE + QHD*SLOTSI) %IF GPCT_FLAGS&BUSY=0 %START J=FIND(GPCT_MNEMONIC); ! TO GET MAPPINGS DONE ! TAKE NEXT REQUEST AND INITIATE %IF CA_PAW#0 %THEN PAW NOT CLEARED(PT,STRM) *LXN_CAA *INCT_(%XNB+0) *JCC_8, SEMALOOP(CA_MARK) GOT4: CA_PAW=D_PAW SENT_SAW0=D_USAW0; ! SAW FLAGS + RCB BOUND SENT_SAW1=D_URCB AD ! FREE COMMS AREA SEMAPHORE AND SEND CHANNEL FLAG BREG=TRUNKADDR ! (PT<<16) CA_MARK=-1 *LB_BREG *LSS_1 *ST_(0+%B) GPCT_FLAGS=GPCT_FLAGS ! BUSY D_SECS SINCE=0 %FINISH %FINISH %IF CA_PIW0#0 %THEN -> MORE INTS -> OUT ! !------------------------- INTERRUPTS ALL TAKEN ----------------------- NO BITS SET: CA_MARK=-1 -> OUT ! REPLY OK: FLAG=0 FAIL: P_DEST=SRCE P_SRCE=GPC DEST ! DACT P_P1=FLAG %IF CALLED=0 %AND P_DEST>>16#0 %THEN PON(P) OUT: INP=P %IF GMON#0 %THEN PRINTSTRING("GPC( OUT):") %AND PTREC(P) %RETURN %ROUTINE RESPOND(%RECORDNAME GPCT,%INTEGER ACT,RESP0,RESP1,SENSFLAGS) %RECORDSPEC GPCT(GPCTF) %RECORD Q(PARMF) %INTEGER DSNO,PONREPLY,DEVTYPE %SWITCH R(0:15) DSNO=GPCT_SERVRT DEVTYPE=GPCT_DEVTYPE Q_DEST=(DSNO<<16) ! ACT %IF DEVTYPE=OP %THEN Q_DEST=Q_DEST ! %C ((GPCT_MECHINDEX>>4)<<8) Q_SRCE=GPC DEST ! 3 Q_P1=RESP0 Q_P2=RESP1 BYTEINTEGER(ADDR(Q_P1))=LOID + SLOT Q_P3=ADDR(D) ! SEND SENSE TERMINATION ANALYSIS FLAGS IN CASE SENSE FAILED ! (ONLY RELEVANT FOR THE CASE OF SENSE TERMINATED) Q_P4=SENSFLAGS Q_P5=GPCT_CSTATUS; ! relevant when READ STREAM'S CONTROLLER STATUS has been requested Q_P6=D_ID %IF DSNO=0 %THEN OPMESS("GPC: UNEXP RESP STRM ". %C STRINT(STRM)." ".HTOS(RESP0,8)) %AND %RETURN PONREPLY=GPCT_FLAGS&PONR %IF GMON#0 %START PRINTSTRING("GPC(") %IF PONREPLY=0 %THEN PRINTSTRING("CALLS") %ELSE %C PRINTSTRING(" PONS") PRINTSTRING("):") PTREC(Q) %FINISH %IF PONREPLY#0 %THEN PON(Q) %AND %RETURN -> R(DEVTYPE) R(5): TAPE(Q); %RETURN R(8): OPER(Q); %RETURN R(14): MK1 FE ADAPTOR(Q); %RETURN R(6): PRINTER(Q) R(0):R(1):R(2):R(3):R(4):R(7):R(9):R(10):R(11):R(12):R(13): R(15): ! (FORMERLY LINK) %END; ! RESPOND !------------------------------------------------------------------------ %INTEGERFN INT WAITING(%INTEGER RESP0,%INTEGERNAME ATTSLOT) %RECORDNAME GE(GPCTF) %INTEGER SLOT,MECH,J %STRING(31) WK %IF RESP0=0 %THEN -> SPUR2 %IF (RESP0>>20) & X'F'# X'1' %START; ! NOT ATTENTION SLOT=STRMQ(GPCNO<<4+STRM) %IF SLOT=ENDLIST %THEN -> SPUR1 GE==RECORD(GPCTBASE + SLOT*SLOTSI) %IF GE_FLAGS&BUSY=0 %THEN OPMESS("GPC: TERM,NOTBUSY " %C .STRINT(STRM)) ATTSLOT=SLOT %RESULT=2; ! RESPONSE OTHER THEN ATTENTION %FINISH MECH=(RESP0>>24)&X'F' SLOT=PTS TO SLOT(((PT-LOPT)<<4) ! STRM) %IF SLOT=ENDLIST %THEN -> SPUR1 GE==RECORD(GPCT BASE + SLOT*SLOTSI) ! MAG TAPE %IF GE_DEVTYPE=MT %THEN SLOT=MECHSLOTS(GE_MECHINDEX+MECH) %IF SLOT=ENDLIST %THEN -> SPUR1 ATTSLOT=SLOT %RESULT=1; ! ATTENTION RESPONSE SPUR1: WK="SPURIOUSINT,PTS ".HTOS(PT<<4!STRM,3) OPMESS(WK) PRINTSTRING(WK); NEWLINE WK="RESP0=".HTOS(RESP0,8) OPMESS(WK) PRINTSTRING(WK); NEWLINE J=READ STRM DATA(PT,STRM,0) SPUR2: ATTSLOT=0; ! ONLY TO AVOID UNASS WITH CHECKS ON IN MAIN BODY %RESULT=0 %END; ! INT WAITING !------------------------------------------------------------------------ %ROUTINE DO MAPPINGS %INTEGER PTSM GPCT==RECORD(GPCTBASE + SLOT*SLOTSI) D==RECORD(GPCT_DEV ENT BASE) PTSM=GPCT_PTSM GPCNO=PTSM>>16 PT=(PTSM>>8)&255; ! PORT AND TRUNK STRM=(PTSM>>4) & 15 MECH=PTSM & 15 CAA=CAAS(GPCNO) QHD==STRMQ(GPCNO<<4 + STRM) CA==RECORD(CAA) SENT==CA_SENTRY(STRM) %END; ! DO MAPPINGS %INTEGERFN FIND(%INTEGER INF) ! SEARCH GPC TABLE FOR DEVICE ! RESULT -1 IF NOT FOUND %INTEGER AD,SL FOVER: AD=GPCT BASE SL=0 %WHILE SL<=LAST SLOT %CYCLE GPCT==RECORD(AD) %IF INF=LOID + SL %OR INF=GPCT_MNEMONIC %OR %C INF=GPCT_PTSM&X'FFFF' %OR %C (INF=M'LP' %AND GPCT_MNEMONIC>>8=M'LP' %AND %C GPCT_PROPS03&X'80'=0) %START SLOT=SL DO MAPPINGS %RESULT=SL %FINISH SL=SL+1 AD=AD+SLOTSI %REPEAT %IF INF=M'LP' %THEN INF=M'LP0' %AND -> FOVER %RESULT=-1 %END; ! FIND %END; ! GPC !!!!! EMAS 2900 OPERator console handler January 1979 ! !SYMBOLS ! %CONSTINTEGER ENL = X'1D'; !EBCDIC NEWLINE %CONSTINTEGER ESP = X'40'; !EBCDIC SPACE %CONSTINTEGER NL = 133 %CONSTINTEGER OLDNL = 10 %CONSTINTEGER FLASH=17 ! %CONSTINTEGER RESIDENT SERS = 64 %CONSTINTEGER LAST PROC = 127 ! %OWNINTEGER MON FLAG = 8; ! &1 = TRACE ! &2 = KICK DISPLAY ! &4 = DON'T ECHO (SYSTEM) ON LOG ! &8 = DON'T ECHO (USER) !*********************************************************************** !* * !* PARAM_DEST = X'00320000' + WHICH OPER<<8 + ACTIVITY * !* * !* ACTIVITY: 1 - SET MONITOR FLAG FROM PARAM_P1 (0 = OFF) * !* 2 - NORMAL TERMINATION * !* 3 - ATTENTION INTERRUPT, PARAM_P1 = FLAGS * !* 4 - INITIALISE OPER * !* 5 - ABNORMAL TERMINATION * !* 6 - PAGED DISPLAY FOR BILL * !* 7 - OUTPUT PARAM_TEXT * !* 8 - INPUT, PARAM_TEXT = PROMPT STRING * !* 9 - DISPLAY LEFT-HAND SCREEN * !* 10 - NOMINATE MAIN OPER PARAM_P1 (-1 == THIS) * !* * !*********************************************************************** %RECORDFORMAT PARMFM(%INTEGER DEST, SRCE, P1, P2, P3, P4, P5, P6) %RECORDFORMAT MESSFM(%INTEGER DEST, SRCE, %STRING(23) TEXT) %RECORDFORMAT BILLFM(%INTEGER DEST, SRCE, %BYTEINTEGER LINE,POS,ZERO,%C %STRING(20) TEXT) %RECORDFORMAT RCBFM(%INTEGER FLAGS,LSTBA,LBSIZE,LBA,ALSIZE,ALA,X1,X2) %RECORDFORMAT UNITFM(%RECORD RCB(RCBFM), %C %INTEGER ALE0S,ALE0A, ALE1S,ALE1A, %C %INTEGER ALE2S,ALE2A, ALE3S,ALE3A, %C %INTEGER ALE4S,ALE4A, ALE5S,ALE5A, %C %INTEGER ALE6S,ALE6A, ALE7S,ALE7A, %C %INTEGER ALE8S,ALE8A, %C %INTEGER ALE10A, ALE12A, %C %INTEGER LBE1, LBE2, LBE3, LBE4, %C %INTEGER LBE5, LBE6, LBE7, %C %INTEGER SCREEN,ASKER,%C %BYTEINTEGER TERM STATE, LOCK,ENTER, ESC, %C %BYTEINTEGER READQ, WRITEQ, INPUT MODE, %C %BYTEINTEGER USING, SINGLE, RESET, KICK DISPLAY, %C %BYTEINTEGER SNO, INPUT ENABLED, PENDING, %C %STRING(63) MESSAGE, %STRING(39) PROMPT, %C %INTEGER FREE); ! 272 BYTES (EXCL FREE) %CONSTINTEGER OP CON SIZE = 272; ! SIZE OF OPER CONTEXT (BYTES) %CONSTINTEGER SCREEN SIZE = 984; ! SCREEN SIZE (BYTES) ! %CONSTINTEGER SCREENS = 6; !NUMBER OF VIRTUAL SCREENS %CONSTSTRING(1) SLF= " " %OWNSTRING(1) SNL = " " %CONSTINTEGER CALL BIT = X'80000000' %CONSTINTEGER LINE = 41; ! CHARS ON OPER LINE (+NL) %CONSTINTEGER ALLOCATE DEVICE = 4 %CONSTINTEGER INITIALIZE = 4 %CONSTINTEGER INT ACT = 6; ! NON-INHIBIT LIMIT ! ! %ROUTINESPEC STRIP NEWLINES(%STRINGNAME MESS) %ROUTINESPEC CLEAR SCREEN(%INTEGER BASE) %ROUTINESPEC DISPLAY TEXT(%INTEGER WHICH,LNO,POS, %STRING(41) X) ! %OWNINTEGERARRAY CONTEXT(0:15); ! ADDRESS OF UNIT CONTEXT %OWNBYTEINTEGERARRAY RMAP(0:15) = 0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15 %OWNBYTEINTEGERARRAY VMAP(0:15) = 0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15 ! %EXTERNALROUTINE OPER(%RECORDNAME PARAMETER) %RECORDSPEC PARAMETER(PARMFM) %CONSTINTEGER SNO = X'32'; ! SYSTEM SNO FOR OPER %CONSTINTEGER OPER CALL SRCE = X'80320000' ! ! INTERRUPT FLAG WORDS ! %CONSTINTEGER ENTER BIT = X'00008000' %CONSTINTEGER COMMAND BIT = X'00002000' %CONSTINTEGER FWD BIT = X'00001000' %CONSTINTEGER REV BIT = X'00000100' ! ! STATES ! %CONSTINTEGER IDLE = 0 %CONSTINTEGER READ DONE = 1 %CONSTINTEGER WRITE DONE = 2 %CONSTINTEGER PROMPT DONE = 3 %CONSTINTEGER ECHO DONE = 4 ! %CONSTINTEGER COMMANDED = 1 %CONSTINTEGER REQUESTED = 2 ! ! %ROUTINESPEC ROTATE(%RECORDNAME U) %ROUTINESPEC UPDATE(%RECORDNAME U, %INTEGER BASE) %ROUTINESPEC RESET %ROUTINESPEC HELP %ROUTINESPEC REPORT(%STRING(63) MESSAGE) %ROUTINESPEC NOMINATE(%INTEGER N) %ROUTINESPEC FIRE(%INTEGER CHAIN, COMMAND, SIZE, BUFFER) ! %RECORD PARAM(PARMFM) ! %OWNRECORDARRAY PARM(1:25)(MESSFM); ! INTERNAL MESSAGE QUEUE %OWNBYTEINTEGERARRAY QUEUE(1:25) = 2,3,4,5,6,7,8,9,10,11,12, 13,14,15,16,17,18,19,20,21, 22,23,24,25,0 %OWNINTEGER ASL = 1 ! ! LOGIC BLOCKS ! %OWNINTEGER IN LBE = X'00F00204' %CONSTINTEGERARRAY OUT LBE(0:3) = %C X'04010800', X'84E00100', X'84E00500', X'80E00302' ! CONNECT, INITIALIZE, W-CONTROL, WRITE %CONSTINTEGERARRAY OUT SCREENS LBE(1:7) = %C X'84E00100', X'84E00506', X'80E00308', X'84E0050A', X'80E0030C', X'84E0050E', X'80E00310' ! ! WRITE-CONTROL WORDS ! %OWNINTEGER REFRESH = X'00140000'; ! LINE 0, 20 %OWNINTEGER PROMPT COMM = X'15010000'; ! LINE 21, 2 %OWNINTEGER ECHO COMM = X'15030000'; ! LINE 21, 3 %OWNINTEGER WHOLE 1 = X'00180000'; ! WHOLE OF SCREEN 1 %OWNINTEGER WHOLE 2 = X'20180000'; ! WHOLE OF SCREEN 2 %OWNINTEGER WHOLE 3 = X'40180000'; ! WHOLE OF SCREEN 3 %OWNINTEGER WHOLE 4 = X'60180000'; ! WHOLE OF SCREEN 4 ! %OWNINTEGER INPUT, OUTPUT ! ! %OWNSTRING(40) ERROR = E" *** INPUT IGNORED *** " %OWNSTRING(42) CPROMPT = E"COMMAND: " %OWNSTRING(42) CONT PROMPT = E"CONTINUE: " ! %SWITCH ACT(0:15), TERM(0:7) %OWNINTEGER FIRST = 1 %INTEGER WHICH; ! OPER REQUIRED %BYTEINTEGERNAME Q %INTEGER ACTIVITY; ! ACTIVITY REQUIRED %STRING(41) MESS; ! WORK STRING FOR TEXT %STRING(96) INPUT STRING %INTEGER C; ! CELL POINTER FOR QUEUE %INTEGER J,K,L, N, SYM, BASE %RECORDNAME BILL(BILLFM) %RECORDNAME MP(MESSFM); ! P1-6 IN STRING FORMAT %RECORDNAME U,HELPU(UNITFM); ! UNIT CONTEXT POINTER %RECORD P(PARMFM); ! WORK RECORD FOR MESSAGES PARAM = PARAMETER; ! COPY ACROSS FOR SAFETY MP == PARAM N = PARAM_DEST WHICH = N>>8&15; ACTIVITY = N&15 WHICH = VMAP(WHICH) %IF ACTIVITY < INTACT !*********************************************************************** ! 'WHICH' IS THE "VIRTUAL" OPER FROM NOW ON !*********************************************************************** BASE = CONTEXT(RMAP(WHICH)) %IF BASE = 0 %START; ! NOT ALLOCATED %IF ACTIVITY # INITIALIZE %START REPORT("NOT INITIALIZED"); %RETURN %FINISH ! ! INITIALIZE OPER 'WHICH' ! INPUT = ADDR(IN LBE); OUTPUT = ADDR(OUT LBE(1)) ! ! ! ALLOCATE THE OPER ! SNL=TOSTRING(NL); ! SET UP 133 NL P = 0; ! JUST IN CASE J = RMAP(WHICH)+'0'; J = J-'0'-10+'A' %IF J > '9' P_P1 = M'OP'<<8+J P_DEST = ALLOCATE DEVICE; P_SRCE = OPER CALL SRCE GPC(P); ! ALLOCATE %IF P_P1 # 0 %START; ! ALLOCATE FAILS REPORT("FAILS TO ALLOCATE: REPLY = ".STRINT(P_P1)); %RETURN %FINISH ! ! CLAIM SPACE FOR CONTEXT ! %IF P_P4&1 = 0 %START; ! NO MAIN SCREEN! REPORT("NO MAIN SCREEN"); %RETURN %FINISH %IF OP CON SIZE+SCREEN SIZE*6 > P_P5 %START; ! NOT ENOUGH SPACE GIVEN REPORT("NO SPACE FOR CONTEXT"); %RETURN %FINISH CONTEXT(WHICH) = P_P3; U == RECORD(P_P3); U = 0; ! CLEAR IT OUT U_SNO = P_P2; !GPC'S SNO FOR OPER U_RCB_FLAGS = X'00FF4000' U_RCB_LBSIZE = 7*4 U_RCB_ALSIZE = 9*2*4 U_RCB_ALA = ADDR(U_ALE0S) ! U_ALE0S = 2 U_ALE2S = LINE-1 U_ALE3S = 2; U_ALE3A = ADDR(WHOLE 2) U_ALE4S = LINE*24 U_ALE5S = 2; U_ALE5A = ADDR(WHOLE 3) U_ALE6S = LINE*24 U_ALE7S = 2; U_ALE7A = ADDR(WHOLE 4) U_ALE8S = LINE*24 MOVE(7*4, ADDR(OUT SCREENS LBE(1)), ADDR(U_LBE1)); ! COPY LBE U_LBE3 = X'84E00308' %IF P_P4&4 # 0; !ENABLE THIRD SCREEN U_LBE5 = X'84E0030C' %IF P_P4&8 # 0; !ENABLE FOURTH SCREEN BASE = ADDR(U_FREE); UPDATE(U, BASE) CLEAR SCREEN(BASE) CLEAR SCREEN(BASE+LINE*24*1) CLEAR SCREEN(BASE+LINE*24*2) CLEAR SCREEN(BASE+LINE*24*3) CLEAR SCREEN(BASE+LINE*24*4) CLEAR SCREEN(BASE+LINE*24*5) %IF P_P4&2 # 0 %START; !HAS SEVERAL SCREENS NOMINATE(WHICH) %IF FIRST # 0 %AND CONTEXT(0) # 0 FIRST = 0 %FINISH %ELSE %START U_SINGLE = 1 %FINISH ! U_TERM STATE = WRITE DONE FIRE(ADDR(OUT LBE(0)), ADDR(WHOLE 1), LINE*24, U_SCREEN) %RETURN %FINISH ! !*********************************************************************** ! U == RECORD(BASE); ! UNIT STATE VECTOR %IF B'0000111111101110'&(1< INT ACT %START; ! INHIBITABLE %IF U_TERM STATE # IDLE %OR %C (ACTIVITY = 8 %AND U_LOCK # 0) %START %IF ACTIVITY = 9 %START; ! IGNORE REPEATED DISPLAYS %RETURN %IF U_KICK DISPLAY # 0 %OR ASL = 0 U_KICK DISPLAY = 1 %FINISH %IF ASL = 0 %START; ! NO FREE CELLS U_KICK DISPLAY = 0; !IN CASE IT GETS LOST %CYCLE K = 15, -1, 0; !EXAMINE ALL THE OPERS AND !THROW AWAY THE FIRST OUTPUT !MESSAGE (LOOK AT MAIN OPER !LAST) J = CONTEXT(RMAP(K)) %IF J # 0 %START; !OPER ALLOCATED HELPU == RECORD(J) %IF HELPU_WRITEQ # 0 %START J = HELPU_WRITEQ; !STRIP OFF THE TOP MESSAGE C = QUEUE(J) %IF C = J %START; !EMPTY HELPU_WRITEQ = 0 %FINISH %ELSE %START QUEUE(J) = QUEUE(C) %FINISH QUEUE(C) = ASL; ASL = C PRINTSTRING("**OPER ".STRINT(K)." LOST: ") PTREC(PARM(C)) %EXIT; !SPACE RECLAIMED, CARRY ON %FINISH %FINISH %REPEAT %IF ASL = 0 %START; !STILL NO ROOM PRINTSTRING("**OPER ".STRINT(WHICH)." LOST: ") PTREC(PARAM); %RETURN %FINISH %FINISH %IF ACTIVITY = 8 %THEN Q == U_READQ %ELSE Q == U_WRITEQ C = ASL; ASL = QUEUE(ASL);! NEW CELL FOR MESSAGE PARM(C) = PARAM; ! COPY MESSAGE %IF Q = 0 %START QUEUE(C) = C %FINISH %ELSE %START QUEUE(C) = QUEUE(Q); QUEUE(Q) = C %FINISH Q = C %RETURN %FINISH %FINISH PTREC(PARAM) %IF MON FLAG&1 # 0 ->ACT(ACTIVITY) ! !**************************************************************** ACT(1):PRINTSTRING("OPER MON PON: ") PTREC(PARAM) MON FLAG = PARAM_P1; %RETURN;! MONITOR !**************************************************************** ACT(2):->TERM(U_TERM STATE) TERM(0):REPORT("SPURIOUS TERMINATION"); HELP; %RETURN;! IDLE !**************************************************************** ACT(5): REPORT("ABNORMAL TERMINATION"); HELP; ->TERM2 TERM(3):! PROMPT DONE U_INPUT ENABLED = 1; U_LOCK = 1 TERM2: TERM(2):! WRITE DONE U_TERM STATE = IDLE ->READ %IF U_ENTER # 0 ->COM %IF U_ESC # 0 Q == U_READQ Q == U_WRITEQ %IF Q = 0 %OR U_LOCK # 0 %RETURN %IF Q = 0 C = QUEUE(Q) %IF C = Q %START Q = 0 %FINISH %ELSE %START QUEUE(Q) = QUEUE(C) %FINISH QUEUE(C) = ASL; ASL = C PARAM = PARM(C) ACTIVITY = PARAM_DEST&15 PTREC(PARAM) %IF MON FLAG&1 # 0 -> ACT(ACTIVITY) TERM(4):! ECHO DONE ->UPROM %IF U_PENDING # 0; ! RESTORE USER REQUEST ->TERM(WRITE DONE) TERM(1):! READ DONE U_LOCK = 0 INPUT STRING = "" L = U_SCREEN+LINE*23; K = 0 %CYCLE J = 1, 1, LINE SYM = BYTEINTEGER(L) %IF SYM = ENL %OR K # 0 %START BYTEINTEGER(L) = ESP K = 1 %FINISH %ELSE %START INPUT STRING = INPUT STRING.TOSTRING(SYM) %FINISH L = L+1 %REPEAT ETOI(ADDR(INPUT STRING)+1, LENGTH(INPUT STRING)) %IF U_INPUT MODE = COMMANDED %START REPORT("<- ".INPUT STRING) %IF MON FLAG&4 = 0 INPUT STRING = U_MESSAGE.INPUT STRING %IF INPUT STRING#"" %AND %C CHARNO(INPUT STRING, LENGTH(INPUT STRING)) = '&' %START CHARNO(INPUT STRING, LENGTH(INPUT STRING)) = ' ' U_MESSAGE <- INPUT STRING U_TERM STATE = PROMPT DONE FIRE(OUTPUT, ADDR(PROMPT COMM), LINE, ADDR(CONT PROMPT)+1) %RETURN %FINISH INPUT STRING = INPUT STRING." "; U_MESSAGE = "" PARSE COM(X'00320007'+WHICH<<8, INPUT STRING) %FINISH %ELSE %START REPORT("<= ".INPUT STRING) %IF MON FLAG&8 = 0 INPUT STRING = INPUT STRING.SLF %CYCLE MP_DEST = U_ASKER; MP_SRCE = SNO<<16!CALL BIT!WHICH<<8 MP_TEXT <- INPUT STRING PON(MP) L = LENGTH(INPUT STRING)-23 %EXIT %IF L <= 0 LENGTH(INPUT STRING) = L MOVE(L, ADDR(INPUT STRING)+24, ADDR(INPUT STRING)+1) %REPEAT %FINISH WIPE: U_TERM STATE = ECHO DONE; U_INPUT MODE = 0 FIRE(OUTPUT, ADDR(ECHO COMM), LINE*3, U_SCREEN+LINE*21) %RETURN !********************************************************************** ACT(3):! ATTENTION INTERRUPT %IF PARAM_P1&ENTER BIT # 0 %START %IF U_TERM STATE # IDLE %START U_ENTER = 1; %RETURN %FINISH READ: U_ENTER = 0 %IF U_USING # 0 %START U_USING = 0; U_TERM STATE = 5; ->DO7 %FINISH TERM(5): %IF U_INPUT ENABLED = 0 %START; ! IGNORE THE LINE MOVE(40, ADDR(ERROR)+1, U_SCREEN+LINE*23) ->WIPE %FINISH U_INPUT ENABLED = 0; U_ENTER = 0 U_TERM STATE = READ DONE FIRE(INPUT, 0, 0, 0) %RETURN %FINISH %IF PARAM_P1&COMMAND BIT # 0 %START %IF U_TERM STATE # IDLE %START U_ESC = 1 %UNLESS U_INPUT MODE = COMMANDED %RETURN %FINISH COM: U_PENDING=1 %IF U_INPUT ENABLED # 0 %AND U_INPUT MODE=REQUESTED %IF U_USING # 0 %START U_USING = 0; U_TERM STATE = 6; ->DO7 %FINISH TERM(6): U_TERM STATE = PROMPT DONE; U_ESC = 0; U_INPUT MODE = COMMANDED FIRE(OUTPUT, ADDR(PROMPT COMM), LINE+1, ADDR(CPROMPT)+1) %RETURN %FINISH %IF PARAM_P1&(FWD BIT!REV BIT) # 0 %START %IF U_SINGLE # 0 %START U_PENDING=1 %IF U_INPUT ENABLED#0 %AND %C U_INPUT MODE = REQUESTED U_INPUT ENABLED=0 %IF PARAM_P1&FWD BIT # 0 %START U_USING = U_USING+1 U_USING = 0 %IF U_USING = 6 %FINISH %ELSE %START U_USING = 6 %IF U_USING = 0 U_USING = U_USING-1 %FINISH U_RESET=15 %IF U_USING=0 %FINISH %ELSE ROTATE(U) %FINISH P_DEST = X'00320009'+WHICH<<8 OPER(P) %RETURN !********************************************************************** ACT(7): ! OUTPUT REQUEST LENGTH(MP_TEXT) = 23 %IF LENGTH(MP_TEXT) > 23 MESS = MP_TEXT STRIP NEWLINES(MESS) L = MP_SRCE>>16 %IF L < RESIDENT SERS %THEN L=0 %ELSE L=L-RESIDENT SERS L = L&LAST PROC MESS = STRINT(L)."/ ".MESS MESS = " ".MESS %IF L <= 9 MESS = MESS." " %WHILE LENGTH(MESS) < 40 REPORT(MESS) %IF (MON FLAG&4 = 0 %AND L <= 3 ) %C %OR (MON FLAG&8 = 0 %AND L > 3) ITOE(ADDR(MESS)+1, 40) U_TERM STATE = WRITE DONE; ! MAKE SURE LOCKED! MOVE(LINE*23, U_SCREEN+LINE*(24*(SCREENS-1)+1), %C U_SCREEN+LINE*(24*(SCREENS-1) ) ) MOVE(LINE, U_SCREEN, U_SCREEN+LINE*(24*SCREENS-1)) P_DEST = X'00320009'+WHICH<<8; OPER(P) MOVE(LINE*20, U_SCREEN+LINE, U_SCREEN); ! SCROLL MOVE(40, ADDR(MESS)+1, U_SCREEN+LINE*20) RESET %IF U_SINGLE # 0 %AND U_USING#0 DO7: FIRE(OUTPUT, ADDR(REFRESH), LINE*21, U_SCREEN) %RETURN !********************************************************************** ACT(8): ! INPUT REQUEST U_ASKER = PARAM_SRCE; ! REMEMBER WHO ASKED LENGTH(MP_TEXT) = 23 %IF LENGTH(MP_TEXT) > 23 MESS = MP_TEXT STRIP NEWLINES(MESS) L = MP_SRCE>>16 %IF L < RESIDENT SERS %THEN L=0 %ELSE L=L-RESIDENT SERS MESS = MESS." from ".STRINT(L&LAST PROC).SNL.SNL ITOE(ADDR(MESS)+1, LENGTH(MESS)); ! TRANSLATE TO EBCDIC U_PROMPT = MESS; ! REMEMBER FOR LATER UPROM: %IF U_USING#0 %START U_USING=0 U_TERM STATE=7 ->DO7 %FINISH TERM(7): U_PENDING = 0 U_TERM STATE = PROMPT DONE; U_INPUT MODE = REQUESTED FIRE(OUTPUT, ADDR(PROMPT COMM), LENGTH(U_PROMPT), ADDR(U_PROMPT)+1) %RETURN !**************************************************************** ACT(9):! DISPLAY LEFT HAND SCREEN %IF U_SINGLE # 0 %START %RETURN %IF U_USING = U_RESET %FINISH U_TERM STATE = WRITE DONE; U_KICK DISPLAY = 0 %IF U_SINGLE # 0 %START U_TERM STATE=ECHO DONE %IF U_PENDING#0 U_RESET = 0 FIRE(OUTPUT, ADDR(WHOLE1), LINE*24, %C U_SCREEN+LINE*24*U_USING) %FINISH %ELSE %START FIRE(ADDR(U_LBE1), 0, 0, 0) %FINISH %RETURN !*************************************************************** ACT(10):! NOMINATE MAIN OPER L = PARAM_P1; ! NEW MAIN OPER L = PARAM_SRCE>>8&15 %IF L = -1 ! SRCE WHICH SET BY 'PARSECOMM' %IF L&(\15) # 0 %START; ! OUT OF RANGE MP_TEXT = "NO SUCH OPER"; ->ACT(7) %FINISH %IF CONTEXT(L) = 0 %START; ! NOT ALLOCATED MP_TEXT = "OPER NOT ALLOCATED"; ->ACT(7) %FINISH NOMINATE(L); %RETURN !******************************************************************** ACT(6):! SPECIAL FOR BILL BILL == PARAM L=BILL_LINE//24 + 1 J=L*LINE*24 + U_SCREEN %IF 0>31) ! (MONFLAG&2) WHICH = WHICH&15 C = CONTEXT(RMAP(WHICH)) %RETURN %UNLESS C # 0 %AND 0 <= LNO <= 24*(SCREENS-1)-1 %C %AND 0 <= POS < 40 %RETURN %IF X = "" U == RECORD(C) P = U_SCREEN+LINE*(24+LNO) LEN = LENGTH(X) N = 39-POS+1; !CHARS LEFT ON LINE LEN = N %IF N < LEN; !CHOOSE MINIMUM LENGTH(X) = LEN STRIP NEWLINES(X) ITOE(ADDR(X)+1, LEN) MOVE(LEN, ADDR(X)+1, P+POS) %IF DISPLAY&3 # 0 %START PP_DEST = X'00320009'+WHICH<<8 OPER(PP) %FINISH %END %ENDOFFILE