DataMuseum.dk

Presents historical artifacts from the history of:

CR80 Hard and Floppy Disks

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about CR80 Hard and Floppy Disks

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download

⟦b78fe534a⟧ TextFile

    Length: 8848 (0x2290)
    Types: TextFile
    Names: »CH.IO.S«

Derivation

└─⟦e12128f26⟧ Bits:30005200 8" Zilog MCZ/1 Floppy CR80FD_0026 ( TC 500 SEC. PROTOCOL BB V1 830407 NCJ )
    └─ ⟦this⟧ »CH.IO.S« 

TextFile

!******************************************************************************
*
*		CHANNEL_INPUT_OUTPUT  MODULE
*
******************************************************************************!
CHANNEL_INPUT_OUTPUT MODULE
 
TYPE
   BUFFER RECORD
      [BUFF_HEAD ARRAY[4 WORD]
      STAADR ^BYTE
      DATA ARRAY[504 BYTE]]
   REC_PTR ^BUFFER
 
   CONFIG_TABLE ARRAY[10,4 BYTE]
   CONFIG_TAB_PTR ^CONFIG_TABLE
 
   QUEU_HEAD ARRAY[8 BYTE]
   QUEU_HEAD_PTR ^QUEU_HEAD
 
   PWQ_HEAD ARRAY[8 BYTE]
   PWQ_PTR ^PWQ_HEAD
 
   TRQ_HEAD ARRAY[8 BYTE]
   TRQ_PTR ^TRQ_HEAD
 
   PARAM_TABLE RECORD
      [B ARRAY[20 BYTE]
      W QUEU_HEAD_PTR
      P CONFIG_TAB_PTR
      PWQ PWQ_PTR
      TRQ TRQ_PTR]
   DATA_PTR ^PARAM_TABLE
 
   PROCESS_TABLE RECORD
      [B ARRAY[4 BYTE]
      POLL_RATE WORD]
   TABLE_PTR ^PROCESS_TABLE
 
CONSTANT
 
   NO_CADERROR	:= 0
   TRUE		:= %FF
   FALSE	:= 0
   OK		:= %0
   LOOP_CODE	:= %31
   EOT		:= 4
   POL		:= %70
   FSL		:= %73
   CON		:= %07
   ACK		:= %06
   NACK		:= %15
   DATA		:= 0
   NO_OF_CLUSTERS := 10
   OVERLOAD	:= %FF
   EMPTY	:= 0
 
   ! CONSTANTS REFERRING TO OFFSET IN BUFFER !
 
   STATUS_OFFSET	:= 2
   P_C1			:= 5
   P_C2			:= 6
   D_C1			:= 26
   D_C2			:= 25
   DATA1_OFFSET		:= 13
   DATA2_OFFSET		:= 14
   LOOP_OFFSET		:= 27
   TYPE_OFFSET		:= 4
   EOT_OFFSET		:= 7
 
   ! CONSTANTS REFERRING TO OFFSET IN PARAMETER TABLE !
 
   CR80_RESP_QUEU	:= 0
   CH_NO	:= 6
   CAD1		:= 12
   CAD2		:= 13
   ACK_STATUS	:= 16
 
   ! CONSTANTS REFERRING TO OFFSET IN PROCESS TABLE !
 
   POLL_COMMAND	:= 0
 
EXTERNAL
 
   TRQBUF PROCEDURE (CAD1,CAD2 BYTE,TRQ TRQ_PTR) RETURNS (BUF_PTR REC_PTR)
   PUTBUF PROCEDURE (QUEU_ADDRESS QUEU_HEAD_PTR,BUF_PTR REC_PTR)
   PUTPWQ PROCEDURE (QUEU_ADDRESS PWQ_PTR,BUF_PTR REC_PTR)
   CHECK_CAD PROCEDURE (CAD1,CAD2 BYTE,PCT CONFIG_TAB_PTR) RETURNS (STATUS BYTE)
   CL_ACCESS_INDIC PROCEDURE (I BYTE,PCT CONFIG_TAB_PTR,P DATA_PTR)
   TX PROCEDURE (BUF_PTR REC_PTR,COMMAND BYTE,P DATA_PTR)
   INOUT PROCEDURE (BUF_PTR REC_PTR)
   GETBUF PROCEDURE (QUEU_ADDRESS QUEU_HEAD_PTR) RETURNS (BUF_PTR REC_PTR)
   POLOVL PROCEDURE (P DATA_PTR) RETURNS (STATUS BYTE)
   PUTMES PROCEDURE (QUEU_NO BYTE,BUF_PTR REC_PTR)
   PWQBUF PROCEDURE (CAD1,CAD2 BYTE,PWQ PWQ_PTR) RETURNS (BUF_PTR REC_PTR)
   CR80BUF PROCEDURE (BUF_PTR REC_PTR,P DATA_PTR)
   DLCBUF PROCEDURE (BUF_PTR REC_PTR,DLC BYTE)
   STAMP PROCEDURE (BUF_PTR REC_PTR,CH_NO BYTE)
   ACCUM PROCEDURE (BUF_PTR REC_PTR,CH_NO BYTE)
   DECREM PROCEDURE (BUF_PTR REC_PTR) RETURNS (STATUS BYTE)
   GET_CAD PROCEDURE (PCT CONFIG_TAB_PTR) RETURNS (CL_NO,CAD1,CAD2 BYTE)
   POLENQ PROCEDURE (BUF_PTR REC_PTR,CAD1,CAD2 BYTE)
 
!ECHO \f

!
INTERNAL
!*****************************************************************************
* PROCEDURE	:POLL
*
* FUNCTION	: THE PROCEDURE MANAGES THE GROUP POLL HANDLING OF CLUSTERS
*
* INPUTS	: T : POINTER TO PROCESS TABLE
*		  P : POINTER TO PARAMETER TABLE
*
* OUTPUTS	: NONE
****************************************************************************!
 
   POLL PROCEDURE (T TABLE_PTR,P DATA_PTR)
 
   LOCAL
      OUTPUT_BUF_PTR REC_PTR
      I BYTE
   ENTRY
 
      ! RESET ACK STATUS !
      P^.B[ACK_STATUS] := FALSE
 
      DO
	 IF T^.B[POLL_COMMAND] = FALSE THEN EXIT FI
 
	 ! IF CLUSTER STATUS = DOWN THEN EXIT !
	 I := CHECK_CAD (P^.B[CAD1],P^.B[CAD2],P^.P)
	 IF I = NO_OF_CLUSTERS THEN EXIT FI
 
	 ! GET BUFFER IN POLL WAITING QUEUE !
	 OUTPUT_BUF_PTR := PWQBUF (P^.B[CAD1],P^.B[CAD2],P^.PWQ)
 
	 ! IF NO BUFFERS THEN TERMINATE TRANSMISSION !
	 IF OUTPUT_BUF_PTR = NIL THEN
	    OUTPUT_BUF_PTR := GETBUF (P^.W)
	    DLCBUF (OUTPUT_BUF_PTR,EOT)
	    TX (OUTPUT_BUF_PTR,EOT,P)
	    EXIT
	 ELSE
	    ! SET ACK STATUS !
	    P^.B[ACK_STATUS] := TRUE
	    ! TIME STAMP BUFFER !
	    STAMP (OUTPUT_BUF_PTR,P^.B[CH_NO])
	    ! TRANSMIT DATA BUFFER ON LINE !
	    TX (OUTPUT_BUF_PTR,DATA,P)
	    EXIT
	 FI
      OD
   END POLL
 
GLOBAL
!ECHO \f

!
!****************************************************************************
* PROCEDURE	: CHANNEL_IO
*
* FUNCTION	: THE PROCEDURE RECEIVES BUFFERS FROM LINE (GROUP POLL, FAST
*		  SELECT, CONTENTION POLL, ACK, NACK) AND TAKES THE NECESSARY
*		  ACTION
*
* INPUTS	: BUF_PTR : POINTER TO RECEIVE BUFFER
*		  T	  : POINTER TO PROCESS TABLE
*		  P       : POINTER TO PARAMETER TABLE
*
* OUTPUTS	: NONE
***************************************************************************!
 
   CHANNEL_IO PROCEDURE (BUF_PTR REC_PTR,T TABLE_PTR,P DATA_PTR)
 
   LOCAL
      OUTPUT_BUF_PTR REC_PTR
      I,OPCODE,CL_AD1,CL_AD2 BYTE
   ENTRY
   DO
 
      ! IF BUFFER STATUS NOT OK THEN EXIT !
      IF BUF_PTR^.BUFF_HEAD[STATUS_OFFSET] <> OK THEN
	 PUTBUF (P^.W,BUF_PTR)
	 EXIT
      FI
 
      OPCODE := BUF_PTR^.DATA[TYPE_OFFSET]
      IF OPCODE
 
!*****************************************************************************!
      CASE EOT THEN
 
	 ! RESET ACK STATUS !
	 P^.B[ACK_STATUS] := FALSE
 
	 DO
	    ! TRANSFER BUFFERS FROM TRANSM.QUEUE TO POLL WAITING QUEUE !
	    OUTPUT_BUF_PTR := TRQBUF (EMPTY,EMPTY,P^.TRQ)
	    IF OUTPUT_BUF_PTR = NIL THEN EXIT FI
	    PUTPWQ (P^.PWQ,OUTPUT_BUF_PTR)
	 OD
 
	 OPCODE := BUF_PTR^.DATA[EOT_OFFSET]
	 IF OPCODE
 
!****************************************************************************!
      CASE POL THEN
 
	 ! UPDATE CAD1,CAD2 INDICATION IN PARAMETER TABLE !
	 P^.B[CAD1] := BUF_PTR^.DATA[P_C1]
	 P^.B[CAD2] := BUF_PTR^.DATA[P_C2]
 
	 IF T^.B[POLL_COMMAND] = TRUE THEN
 
	    ! GET INDEX NO. OF CLUSTER IN CONFIGURATION TABLE !
	    I := CHECK_CAD (P^.B[CAD1],P^.B[CAD2],P^.P)
 
	    ! IF CLUSTER FOUND THEN SET CLUSTER ACCESS INDICATION !
	    IF I <> NO_OF_CLUSTERS THEN
	       CL_ACCESS_INDIC (I,P^.P,P)
	    FI
	 FI
 
	 ! RETURN POLL BUFFER TO EMPTY BUFFER QUEUE !
	 PUTBUF (P^.W,BUF_PTR)
 
	 POLL (T,P)
 
!*****************************************************************************!
      CASE FSL THEN
 
	 DO
	    ! IF TERMINATION MESSAGE THEN ACK MESSAGE !
	    IF BUF_PTR^.DATA[DATA1_OFFSET] = %30 ANDIF BUF_PTR^.DATA[DATA2_OFFSET] = %49 THEN
	       DLCBUF (BUF_PTR,ACK)
	       TX (BUF_PTR,ACK,P)
	       EXIT
	    FI
 
	    ! ACCUMULATE TIME IN BUFFER !
	    ACCUM (BUF_PTR,P^.B[CH_NO])
 
	    ! REFORMAT BUFFER !
	    INOUT (BUF_PTR)
 
	    ! GET INDEX NO. OF CLUSTER IN CONFIGURATION TABLE !
	    I := CHECK_CAD (BUF_PTR^.DATA[D_C1],BUF_PTR^.DATA[D_C2],P^.P)
 
	    ! IF CLUSTER NOT FOUND THEN EXIT !
	    IF I = NO_OF_CLUSTERS THEN
	       DLCBUF (BUF_PTR,ACK)
	       TX (BUF_PTR,ACK,P)
	       EXIT
	    ELSE
	       IF T^.B[POLL_COMMAND] = TRUE THEN
		  ! SET CLUSTER ACCESS INDICATION !
		  CL_ACCESS_INDIC (I,P^.P,P)
	       FI
	    FI
 
	    ! CHECK LOOP INDICATION !
	    IF BUF_PTR^.DATA[LOOP_OFFSET] = LOOP_CODE THEN
 
	       IF DECREM (BUF_PTR) <> 0 THEN
 
		  IF POLOVL (P) <> OVERLOAD THEN
		  ! IF NO POLL BUFFER OVERLOAD THEN ENQUE BUFFER IN POLL W.QUEUE !
		     PUTPWQ (P^.PWQ,BUF_PTR)
 
		     ! ACK MESSAGE !
		     OUTPUT_BUF_PTR := GETBUF (P^.W)
		     DLCBUF (OUTPUT_BUF_PTR,ACK)
		     TX (OUTPUT_BUF_PTR,ACK,P)
		  ELSE
		     ! NACK MESSAGE !
		     DLCBUF (BUF_PTR,NACK)
		     TX (BUF_PTR,NACK,P)
		  FI
	       ELSE
		  ! SEND BUFFER TO CR80 !
		  CR80BUF (BUF_PTR,P)
	       FI
	    ELSE
	       ! SEND BUFFER TO CR80 !
	       CR80BUF (BUF_PTR,P)
	    FI
	    EXIT
	 OD
 
!****************************************************************************!
      CASE CON THEN
 
	 I,CL_AD1,CL_AD2 := GET_CAD (P^.P)
 
	 IF I <> NO_OF_CLUSTERS THEN
	    ! REPLY ON CONTENTION BUFFER !
	    POLENQ (BUF_PTR,CL_AD1,CL_AD2)
	    TX (BUF_PTR,POL,P)
 
	 ELSE
	    ! ENQUE BUFFER IN EMPTY BUFFER QUEUE !
	    PUTBUF (P^.W,BUF_PTR)
 
	 FI
      ELSE
	 PUTBUF (P^.W,BUF_PTR)
      FI
 
!*****************************************************************************!
      CASE ACK THEN
 
	 PUTBUF (P^.W,BUF_PTR)
 
	 ! TRANSFER BUFFERS FROM TRANSM.QUEUE TO EMPTY QUEUE !
	 DO
	    OUTPUT_BUF_PTR := TRQBUF (EMPTY,EMPTY,P^.TRQ)
	    IF OUTPUT_BUF_PTR = NIL THEN EXIT FI
	    PUTBUF (P^.W,OUTPUT_BUF_PTR)
	 OD
 
	 ! IF ACK STATUS SET DO POLL PROCEDURE !
	 IF P^.B[ACK_STATUS] = TRUE THEN
	    POLL (T,P)
	 FI
 
!*****************************************************************************!
      CASE NACK THEN
 
	 ! RETURN NACK BUFFER TO EMPTY BUFFER QUEUE !
	 PUTBUF (P^.W,BUF_PTR)
 
	 ! IF ACK STATUS SET THEN RETRANSMIT DATA BUFFER !
	 IF P^.B[ACK_STATUS] = TRUE THEN
	    OUTPUT_BUF_PTR := TRQBUF (EMPTY,EMPTY,P^.TRQ)
	    IF OUTPUT_BUF_PTR <> NIL THEN
	       ! TIME STAMP BUFFER !
	       STAMP (OUTPUT_BUF_PTR,P^.B[CH_NO])
	       ! RETRANSMIT BUFFER !
	       TX (OUTPUT_BUF_PTR,DATA,P)
	    ELSE
	       ! RESET ACK STATUS !
	       P^.B[ACK_STATUS] := FALSE
	    FI
	 FI
 
!****************************************************************************!
      ELSE
	 PUTBUF (P^.W,BUF_PTR)
      FI
      EXIT
 
   OD
   END CHANNEL_IO
END CHANNEL_INPUT_OUTPUT
!ECHO \f

!