        SUBTTL BYTE MANIPULATION ROUTINES - FORTRAN CALLABLE
;  CALLING SEQUENCES --
;       POINTE MAKES A BYTE POINTER VIA  P=POINTE(SIZ,PLACE,POS)
;WHERE P AND POINTE MUST BE THE SAME TYPE,SIZ,PLACE AND POS SHOULD
;BE INTEGERS.  SIZ IS THE BYTESIZE IN BITS.  PLACE IS THE VARIABLE INTO WHICH
;IT WILL BE PUT OR FROM WHICH IT WILL BE TAKEN.  POS IS THE BIT-POSITION IN PLAC
;AT WHICH THE BYTE STARTS (LEFT END OF WORD IS BIT 0).
;BEWARE --THE POINTER WILL NOT BE SET UP CORRECTLY IF PLACE HAS BEEN
;PASSED AS AN ARGUMENT TO THE CALLING PROGRAM **UNLESS** PLACE IS
;DIMENSIONED (1) IN THE PROGRAM THAT CALLS POINTE.  IN PDP-10 FORTRAN,
;THIS IS THE ONLY WAY TO CALL AN ARGUMENT BY LOCATION RATHER THAN BY VALUE.
;       L=BYTE(P) GETS THE BYTE POINTED TO BY THE POINTER IN P AND PUTS
;IT IN L.  L AND BYTE MUST BE OF THE SAME TYPE.
;       CALL STRBYT(L,P) STORES THE RIGHTHAND BYTE OF L INTO THE PLACE
;POINTED TO BY THE POINTER IN P.  THE BYTESIZE IS DETERMINED BY THE POINTER.
;       IN BOTH BYTE AND STRBYT,THE POINTER IS INCREMENTED TO POINT TO THE NEXT
;BYTE.
;       LSH SHIFTS A WORD'S BITS TO RIGHT OR LEFT,BRINGING IN ZEROES AS
;NEEDED.  IT IS CALLED BY J=LSH(I,N) WHERE I CONTAINS THE WORD TO
; BE SHIFTED,N IS THE NUMBER OF BITS TO SHIFT (POSITIVE MEANS LEFTWARD
;SHIFT,NEGATIVE MEANS RIGHTWARD) AND !!BOTH!! I AND J CONTAIN THE SHIFTED
;RESULT.  SO COPY FIRST BEFORE SHIFTING.
        ENTRY POINTE,BYTE,STRBYT,LSH
POINTE::        MOVE    @0(16)          ;GET FIRST ARGUMENT
        LSH     6               ;SHIFT LEFT SIX BITS
        MOVEI 1,44              ;LEFT POSITION FOR POINTER START
        SUB 1,@2(16)            ;ADJUST IT FOR 3RD ARGUMENT
        LSH 1,14                ;SHIFT IT LEFT
        ADD 1,0         ;COLLECT THE LEFT HALF
        MOVEI @1(16)            ;GET ADDRESS OF BYTE
        TSO 0,1                 ;MOVE INTO THE POINTER
        POPJ 17,                ;QUIT

BYTE::  ILDB @0(16)             ;PUT THE BYTE IN AC 0
        POPJ 17,

STRBYT::        MOVE @0(16)             ;GET BYTE
        IDPB @1(16)             ;PUT WHERE IT BELONGS
        POPJ 17,
LSH::   MOVE @0(16)             ;GET WORD TO BE SHIFTED
        MOVE 1,@1(16)           ;AND #BITS TO SHIFT
        LSH 0(1)                ;SHIFT
        MOVEM @0(16)            ;SAVE RESULT IN FIRST ARGUMENT
        POPJ 17,
        END
                SUBTTL VARIOUS DEVIOUS MACRO-10 SUBROUTINES TO SAFELY OPEN A
IFNDEF TOPS10,<TOPS10==0>
;TAPE FOR INDUSTRY STANDARD 8-BIT-BYTE MODE.
;       CALLING SEQUENCES --
;       CALL CHNFND(ICHN,ISTAT)  FINDS NEXT FREE CHANNEL FROM FOROTS AND PUTS
;NUMBER IN ICHN.  IF NO CHANNEL IS AVAILABLE ISTAT=3.
;       CALL CHNCHK(ICHN,TAPDEV,ISTAT) COMPARES THE DEVICE ON CHANNEL
;ICHN AND THAT ASSOCIATED WITH DEVICE TAPDEV.  IF THEY ARE THE SAME
;AND REFER TO A MAGTAPE WE OWN IN IMAGE MODE, IT IS ASSUMED THE CHANNEL
;NUMBER IS THAT ASSOCIATED WITH TAPDEV.  IF NO MATCH,OR
;DEVICE IS NOT A TAPE, ISTAT=3.
;       CALL TAPSET(ICHN) SETS THE TAPE FOR INDUSTRY STANDARD MODE,
;I.E.,800 BPI,ODD PARITY,8-BIT BYTES THAT GET PACKED 4 PER 36-BIT
;WORD IN THE TAPE BUFFER.
;       CALL DMPIN (BLOCK,ICHN,NWDS,IEOF,IERR)
;WHERE BLOCK IS AN ARRAY AT LEAST NWDS LONG INTO WHICH A RECORD IS READ FROM
;ICHN IN DUMP MODE.  IERR AND IEOF = ZERO IF OK, IERR = ERROR STATUS IF ERROR
;AND IEOF NOT EQUAL ZERO IF EOF.  EXTRA WORDS ARE IGNORED.
;       CALL DMPOUT (BLOCK,ICHN,NWDS,IERR)
;WHERE NWDS OF BLOCK ARE TO BE WRITTEN ON ICHN IN DUMP MODE.  IERR=0 IF
;NO ERRORS, ELSE IS SET TO THE FILE STATUS.
;
;************  WARNING  ***************
;
;THE DPB INSTRUCTIONS IN TAPSET, DMPIN AND DMPOUT MODIFY CODE.  HENCE THEY CAN
;CONFUSE DDT IF BREAKPOINTS ARE SET AT THE INSTRUCTIONS BEING MODIFIED (DDT
;PLANTS A JSR).  ALSO, THESE ROUTINES CANNOT BE MOVED TO THE HIGH SEGMENT.
        ENTRY CHNFND,CHNCHK,TAPSET
        SUBTTL CHNFND -- FIGURE OUT WHAT NEXT FREE CHANNEL IS
CHNFND::        MOVEM 16,ARGPT          ;SAVE ARGUMENT LIST POINTER
        MOVE 0,[100,,0]         ;SET UP CHANNEL BLOCK
        MOVEM 0,CHNBLK
        SETZ 0,
        MOVEI 16,CHNBLK         ;GET READY
        PUSHJ 17,ALCHN.##       ;ASK FOROTS FOR NEXT FREE I/O CHANNEL
        CAIGE                   ;IF NONE AVAILABLE
          JRST CHNERR           ;BIG TROUBLE
        MOVE 16,ARGPT           ;GET BACK THE ARGUMENT LIST
        MOVEM 0,@0(16)          ;RETURN THE CHANNEL NO.
        MOVEI 16,CHNBLK
        PUSHJ 17,DECHN.##       ;AND DO IT
        CAIGE
          JRST CHNERR           ;DIE ON ERRORS
        POPJ 17,
CHNERR: OUTSTR[ASCIZ/ ?CHNFND:NO CHANNEL AVAILABLE
/]
        MOVE 16,ARGPT
        MOVEI 3,3       ;MAKE ERROR CODE FOR ISTAT
        MOVEM 3,@2(16)          ;AND STORE IT
        POPJ 17,
ARGPT:  BLOCK 1
        -1,,0
        CHNBLK: BLOCK 1

        SUBTTL CHNCHK -- IS THERE A MAGTAPE ON ICHN AS EXPECTED?

CHNCHK::
IFN TOPS10,<
                MOVE 0,@0(16)             ;GET CHANNEL #
        DEVCHR 0,               ;WHAT DEVICE IS IT?
        MOVE 1,@1(16)           ;GET DEVICE NAME IN ASCII
        SETZB 5,4               ;CLEAR TEMP ACS
        MOVNI 6,5               ;NO MORE THAN 5 CHARS IN LOGICAL NAME
SIXCON: MOVE 2,[POINT 7,1]      ;CONVERSION TO SIXBIT-ASCII BYTE POINTER
        MOVE 3,[POINT 6,4]      ;SIXBIT BYTE POINTER
        ILDB 5,2                ;GET A CHARACTER
        SUBI 5,40               ;MAKE SIXBIT
        IDPB 5,3                ;SAVE
        AOSE 6                  ;GO ON WHEN DONE
        JRST SIXCON+2           ;LOOP WHEN NOT
        MOVE 1,4                ;HERE'S CORRECT DEVICE NAME
        DEVCHR 1,
        CAME 1,0                ;ARE THEY THE SAME?
          JRST DEVERR           ;WHOOPS
MTEST:  SETCA 1,                ;COMPLEMENT
        TDNE 1,[1B12!1B13!1B20] ;SEE IF ITS A MAGTAPE WE OWN IN DUMP MODE
          JRST DEVERR           ;CAN'T FIX THIS ERROR
        POPJ 17,
DEVERR: OUTSTR [ASCIZ/ ?CHNCHK:CAN'T MATCH CHANNEL TO DEVICE
/]
        MOVEI 3,3               ;ERROR CODE FOR ISTAT
        MOVEM 3,@2(16)          ;CAN'T FIX,ISTAT=3
>;END IFN TOPS10
        POPJ 17,

        SUBTTL TAPSET -- SET MAGTAP FOR INDUSTRY STANDARD 800-BPI 8-BIT-BYTES

TAPSET::        MOVE 0,@0(16)           ;GET CHANNEL NO.
        MOVE 1,[POINT 4,INDUST,12]      ;POINTER TO AC FIELD OF MTAPE INSTR.
        DPB 0,1                         ;PUT CHANNEL NUMBER THERE
        HRRI 1,GET                      ;POINT TO ACC OF GETSTS
        DPB 0,1                         ;INSERT CHANNEL NUMBER
        HRRI 1,SET                      ;POINT TO ACC OF SETSTS
        DPB 0,1                         ;INSERT CHANNEL NUMBER
INDUST: MTAPE 0,101                     ;SET UP FOR INDUSTRY STANDARD
GET:    GETSTS 0,5                      ;GET FILE STATUS
        IORI 5,17                       ;SET NEW BITS TO
SET:    SETSTS 0,(5)                    ;  CHANGE MODE TO .IODMP
        POPJ 17,
;
        SUBTTL DMPOUT - WRITE VARIABLE LENGTH DUMP MODE RECORDS.
;
DMPOUT:: MOVEI 0,@0(16)                 ;GET BLOCK
        SUBI 0,1                        ;FIND LOC JUST BEFORE IT
        MOVE 2,@1(16)                   ;GET CHANNEL NUMBER
        MOVE 1,[POINT 4,OUTT,12]        ;POINT TO OUT INSTR
        DPB 2,1                         ;PUT CHANNEL NUMBER THERE
        HRRI 1,GETO                     ;POINT TO GETSTS
        DPB 2,1                         ;PUT CHANNEL NUMBER THERE
        MOVE 1,@2(16)                   ;GET SIZE OF BLOCK
        MOVNS 1,1                       ;NEGATE
        MOVSS 1,1                       ;SWAP HALVES
        HRR 1,0                         ;NOW HAVE XWD (-LEN,BLK-1)
        MOVEM 1,COMD                    ;SAVE THE IOWD
OUTT:   OUT 0,COMD                      ;DO THE OUTPUT
        JRST [SETZM @3(16)              ;OK, CLEAR THE ERROR WORD
        POPJ 17,        ]               ;RETURN
GETO:   GETSTS 0,0                      ;GET FILE STATUS IF ERROR
        MOVEM 0,@3(16)                  ;SEND IT BACK VIA IERR
        POPJ 17,                        ;RETURN
COMD:   BLOCK 2                         ;DUMP MODE COMMAND LIST
;
        SUBTTL DMPIN - READ VARIABLE LENGTH DUMP MODE RECORDS
;
DMPIN:: MOVEI 0,@0(16)                  ;GET BLOCK
        SUBI 0,1                        ;FIND LOC JUST BEFORE IT
        MOVE 2,@1(16)                   ;GET CHANNEL NUMBER
        MOVE 1,[POINT 4,INN,12]         ;POINT TO ACC OF IN INSTRUCTION
        DPB 2,1                         ;PUT CHANNEL NUMBER THERE
        HRRI 1,SETI                     ;POINT TO SETSTS INSTR
        DPB 2,1                         ;PUT CHANNEL THERE
        HRRI 1,GETI                     ;POINT TO GETSTS INSTR
        DPB 2,1                         ;PUT CHANNEL THERE
        MOVE 1,@2(16)                   ;GET SIZE OF BLOCK
        MOVNS 1,1                       ;NEGATE
        MOVSS 1,1                       ;SWAP HALVES
        HRR 1,0                         ;NOW HAVE XWD (-LEN,BLOCK-1)
        MOVEM 1,COMDI                   ;SAVE THE IOWD
INN:    IN 0,COMDI                      ;DO THE INPUT
        JRST [SETZM @3(16)              ;OK, CLEAR THE EOF WORD
        SETZM @4(16)                    ;AND THE ERROR WORD
        POPJ 17,        ]               ;RETURN
GETI:GETSTS 0,0                         ;GET FILE STATUS IF ERROR
        MOVE 1,0                        ;MAKE A COPY
        MOVE 2,0                        ;AND ANOTHER
        ANDI 0,20000                    ;IS IT END OF FILE?
        MOVEM 0,@3(16)                  ;RETURN IT IN IEOF
        TRZ 1,77777                     ;IGNORE ALL BITS EXCEPT
                                        ;IO.IMP=ILLEGAL OPERATION
                                        ;IO.DER=DATA MISSED, TAPE BAD OR HUNG
                                        ;IO.DTE=PARITY ERROR
        MOVEM 1,@4(16)                  ;SEND BACK ERROR IF ANY OF ABOVE
        TRZ 2,760000                    ;TURN OFF ALL ERROR BITS
SETI:   SETSTS 0,0(2)                   ;TRY FOR ERROR RECOVERY
        POPJ 17,                        ;RETURN
COMDI:  BLOCK 2                         ;DUMP MODE COMMAND LIST
        END
