'======== TETON SHORT LINE AUTO CAB CONTROL PROGRAM======== 'excerpts from ACC5C31.BAS 'to accompany ACC post on website '05/21/98 'big snip===> DEFINT A-Z: DIM SHARED ASport, StatusReg, Bytcnt, Ocupy(32), Swtch(16), SgnlGrp(12) DIM SHARED YrdRly(10), SgnlTest(3), Sig$(80) DIM INPDAT(32), RRDat(128), Drctn(4), Muxout(16, 4) DIM RQST(24), CURR(24), MuxDat(128), TRNMBR(4), EGNMBR(4), DRCDV(4) DIM WSTM(24), ESTM(24), BRA1(24), SW1(24), SC1(24), BRA2(24), SW2(24), SC2(24) DIM DCH(4), DMS(4), DAR(4), DBKR(4), BCAP(4), DFV(4), DRV(4), DMD(4), DV(4) DIM DP(4), EMG(4), AIR(4), Spd(4), DBK1(4), DBK2(4), DBK3(4), DYCH(4), DSV(4) DefPorts: ' define the port addresses ASport = &H3F8' Async port, COM1 MuxPortAddress: MAport = &H304' 8255 unassigned 8 bit port-A MBport = MAport + 1' 8255 6 bit address + read/write mode to MUX RAM MCport = MAport + 2' 4 data bits + flag + write command to MUX RAM MDport = MAport + 3' address to set up mode & I/O directions 'ACC card, one of two 8255s 'signalling and ACC on this one AAport = &H308' Data to set signal colors ABport = AAport + 1' ACC adrs nibble and data nibble ACport = AAport + 2' LoBits data from ACC- HiBits=to ACC card slct 'ACC card, two of two 8255s DAport = &H30C' 8255 control output to Dynatrol DBport = DAport + 1' data output to Dynatrol DCport = DAport + 2' reserved for future throttle control S0port = &H310' addresses &H310-317 abandoned hardware- available 'previously used port &H300 for 2661 is now available for reassign 'snip==> set8255: ' set up the 8255 PIA OUT MAport + 3, 128' 1000 0000 all ports are outputs OUT AAport + 3, 129' 1000 0001 A&B=output, C=split lo-in & hi-out OUT DAport + 3, 128' 1000 0000 all ports are outputs HiBits = &HF0: LoBits = &HF ' 1111 0000 or 0000 1111 masks Init1: GOSUB ClrRlys 'clear the relays 'snip==> Init2: GOSUB LoadBlkSpecs 'read in the BLocK SPECifications 'snip==> Exec: '================= EXECUTIVE ================================ 'snip==> GOSUB ReadACC 'read RR status GOSUB StorData 'store the RR Status info GOSUB Cabcmnd 'process commands GOSUB DispatcherIn 'dispatcher input GOSUB ReqBlk GOSUB Assign 'Assign the blocks 'snip==> '============== COMMON SUB-ROUTINES ======================== StrbACC: ' ACC card select & strobe Strb = card * 16 AND HiBits: OUT ACport, Strb RETURN Out2Rly: OUTRLY = (Outcab * 32) + Outblk: OUT ABport, OUTRLY ' relay choice in 3 MSBits,, address in 5LSBits card = 0: GOSUB StrbACC 'strobe A2/A3 card = card - 1: GOSUB StrbACC 'kill the strobe RETURN ClrRlys: 'clear the ACC relays FOR Rly = 1 TO 24 CURR(Rly) = 0: Outcab = 0: Outblk = Rly: GOSUB Out2Rly NEXT Rly RETURN 'snip==> '=================== READRR ================================= ReadACC: card = 4: GOSUB StrbACC 'strobe cards A8/A7 'reserved inputs FOR a = 0 TO 15: GOSUB ReadACC1: NEXT a card = 2: GOSUB StrbACC 'strobe cards A6/A5 'inputs in service FOR a = 16 TO 31: GOSUB ReadACC1: NEXT a card = card - 1: GOSUB StrbACC 'kill the strobe GOTO ReadMux ReadACC1: OUT ABport, a INPDAT(a) = INP(ACport) AND LoBits ' 0000 1111 mask the nibble RETURN 'snip==> '===================== STORE INPUT DATA ======================== StorData: StorACCData: 'bits 1-32 from card A8, bits 33-64 from card A7 et al FOR a = 1 TO 128: RRDat(a) = 0: NEXT a FOR a = 1 TO 128 STEP 4'32 bytes, bit-by-bit,LSNibble B = INPDAT((a - 1) \ 4) IF (B AND 1) = 1 THEN RRDat(a) = 1 IF (B AND 2) = 2 THEN RRDat(a + 1) = 1 IF (B AND 4) = 4 THEN RRDat(a + 2) = 1 IF (B AND 8) = 8 THEN RRDat(a + 3) = 1 NEXT a FOR a = 1 TO 32: Ocupy(a) = RRDat(a + 64): NEXT a: 'from card A5 FOR a = 1 TO 16: Swtch(a) = RRDat(a + 104): NEXT a: 'from card A6 YrdRly(1) = RRDat(97): YrdRly(3) = RRDat(98) 'from card A6 FOR a = 5 TO 10: YrdRly(a) = RRDat(a + 94): NEXT a: 'snip==> '================== DISPATCHER INPUT ========================== 'snip==> material here is snipped because it is deeply integrated with the MUX cab system in this version. '=================== REQBLK =================================== ReqBlk: FOR Blk = 1 TO 24: RQST(Blk) = 0: NEXT Blk 'wipe out old requests FOR Blk = 1 TO 24 IF Ocupy(Blk) <> 0 THEN 'occupied RVSP = 0 'assume normal polarity IF Blk = 18 AND Swtch(11) = 1 THEN RVSP = -1 'drctn polarity IF Blk = 19 AND Swtch(6) = 1 THEN RVSP = -1 'drctn polarity RCAB = CURR(Blk) 'yields 0,1,2, or 4 WEST = Drctn(RCAB) AND 1 EAST = Drctn(RCAB) AND 2 IF RVSP THEN 'if reverse polarity WEST = Drctn(RCAB) AND 2 EAST = Drctn(RCAB) AND 1 'reverse it END IF IF WEST THEN GOSUB ReqWest2 IF EAST THEN GOSUB RegEast1 END IF NEXT Blk RETURN ReqWest2: IF SW2(Blk) = 0 THEN GOTO ReqWest1 'no switch IF (SC2(Blk) AND 1) = 1 THEN GOTO ReqWest1 'not at west end NMBR = SW2(Blk) IF Swtch(NMBR) * 4 <> (SC2(Blk) AND 4) THEN GOTO ReqWest1 'aligned to main IF (SC2(Blk) AND 2) = 0 THEN RETURN 'open & trailing GOTO ReqBrnch2 'branch #2 ReqWest1: IF SW1(Blk) = 0 THEN GOTO ReqWest 'no switch IF (SC1(Blk) AND 1) = 1 THEN GOTO ReqWest 'not at west end NMBR = SW1(Blk) IF Swtch(NMBR) * 4 <> (SC1(Blk) AND 4) THEN GOTO ReqWest 'aligned to main IF (SC1(Blk) AND 2) = 0 THEN RETURN 'open & trailing GOTO ReqBrnch1 'branch #1 RegEast1: IF SW1(Blk) = 0 THEN GOTO ReqEast2 'RQEST2 no switch IF (SC1(Blk) AND 1) = 0 THEN GOTO ReqEast2 'not at east end NMBR = SW1(Blk) IF Swtch(NMBR) * 4 <> (SC1(Blk) AND 4) THEN GOTO ReqEast2 'aligned to main IF (SC1(Blk) AND 2) = 0 THEN RETURN 'open & trailing GOTO ReqBrnch1 'branch #1 ReqEast2: IF SW2(Blk) = 0 THEN GOTO ReqEast 'no switch IF (SC2(Blk) AND 1) = 0 THEN GOTO ReqEast 'not at east end NMBR = SW2(Blk) IF Swtch(NMBR) * 4 <> (SC2(Blk) AND 4) THEN GOTO ReqEast 'aligned to main IF (SC2(Blk) AND 2) = 0 THEN RETURN 'open & trailing GOTO ReqBrnch2 'branch #2 ReqWest: VREQ = WSTM(Blk): GOTO ReqPut 'Valid Request ReqEast: VREQ = ESTM(Blk): GOTO ReqPut 'Valid Request ReqBrnch1: VREQ = BRA1(Blk): GOTO ReqPut 'Valid Request ReqBrnch2: VREQ = BRA2(Blk): GOTO ReqPut 'Valid Request ReqPut: RQST(VREQ) = (RQST(VREQ) OR RCAB) 'accumulate requests RETURN '=================== ASSIGN =================================== Assign: Denial = 0 FOR Blk = 1 TO 24 IF RQST(Blk) = 0 THEN GOTO AssignNxt 'no requests IF Ocupy(Blk) = 1 THEN GOTO AssignDeny 'occupied IF (RQST(Blk) AND CURR(Blk)) > 0 THEN GOTO AssignDeny'priority retain C = 1 AssignTest: Newcab = (C AND RQST(Blk)) IF Newcab <> 0 THEN GOTO AssignNew 'ASSNEW valid request C = C * 2: IF C = 16 THEN Newcab = 0: GOTO AssignNew Newcab = (Newcab * 2): GOTO AssignTest AssignNew: CURR(Blk) = Newcab AssignDeny: Denial = (Denial OR (RQST(Blk) - (RQST(Blk) AND CURR(Blk)))) AssignNxt: NEXT Blk AssignOut: FOR Blk = 1 TO 24 Outcab = CURR(Blk): Outblk = Blk: GOSUB Out2Rly NEXT Blk Outcab = Denial: Outblk = 30: GOSUB Out2Rly 'denial lamps RETURN 'snip==> '======================= LOAD BLOCKSPECS =================== LoadBlkSpecs: OPEN "I", 1, "BLKSPECS.DAT" LoadBS1: IF EOF(1) THEN GOTO LoadBSdone LINE INPUT #1, a$ IF (LEFT$(a$, 1) = ";" OR LEFT$(a$, 1) = " ") THEN GOTO LoadBS1 IF Analyt THEN ASout LEFT$(a$, 28) Blk = VAL(LEFT$(a$, 2)) IF Analyt THEN ASout STR$(Blk) WSTM(Blk) = VAL(MID$(a$, 4, 2)): ESTM(Blk) = VAL(MID$(a$, 7, 2)) BRA1(Blk) = VAL(MID$(a$, 10, 2)): SW1(Blk) = VAL(MID$(a$, 13, 2)) SC1(Blk) = 4 * VAL(MID$(a$, 16, 1)) + 2 * VAL(MID$(a$, 17, 1)) + VAL(MID$(a$, 18, 1)) IF NOT Analyt THEN GOTO LoadBS2 ASout STR$(WSTM(Blk)) + STR$(ESTM(Blk)) ASout STR$(BRA1(Blk)) + STR$(SW1(Blk)) + STR$(SC1(Blk)) LoadBS2: BRA2(Blk) = VAL(MID$(a$, 20, 2)): SW2(Blk) = VAL(MID$(a$, 23, 2)) SC2(Blk) = 4 * VAL(MID$(a$, 26, 1)) + 2 * VAL(MID$(a$, 27, 1)) + VAL(MID$(a$, 28, 1)) IF NOT Analyt THEN GOTO LoadBS1 ASout STR$(BRA2(Blk)) + STR$(SW2(Blk)) + STR$(SC2(Blk)) CRout "" 'pad the line LoadBSdone: CLOSE : RETURN ' 'snip==>