Trailing-Edge
-
PDP-10 Archives
-
BB-4170G-SM
-
sources/tape.mac
There are 50 other files named tape.mac in the archive. Click here to see a list.
;<3-MONITOR>TAPE.MAC.80, 9-Nov-77 09:58:31, EDIT BY KIRSCHEN
;MORE COPYRIGHT UPDATING...
;<3-MONITOR>TAPE.MAC.79, 12-Oct-77 14:17:07, EDIT BY KIRSCHEN
;UPDATE COPYRIGHT FOR RELEASE 3
;<3-MONITOR>TAPE.MAC.78, 25-May-77 11:11:47, Edit by HESS
;<3-MONITOR>TAPE.MAC, Edit by MILLER
;ADD SET INPUT/OUTPUT AND ATTRIBUTE CHECK ENTRIES IN DISPATCH TABLE
;<3-MONITOR>TAPE.MAC.48, 5-May-77 16:06:00, Edit by HESS
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1976, 1977, 1978 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
SEARCH PROLOG
TTITLE TAPE,,< - LABEL HANDLER AND RECORD PROCESSOR>
;SPECIAL AC DEFINITIONS USED IN THIS MODULE
DEFAC (U,Q1) ;UNIT NUMBER
DEFAC (IOS,Q2) ;STATUS BITS FROM MTASTS
DEFAC (STS,P1) ;DEVICE STATUS
DEFAC (JFN,P2) ;JFN
DEFAC (DEV,P4) ;DEVICE DISPATCH ADR
DEFINE UCALL (ROU,ARGS) <
IFNB <ARGS>,<
AC.==T1 ;;START WITH T1
IRP <ARGS>,<
MOVE AC.,ARGS ;;LOAD ACS
AC.==AC.+1
>
>
JSP CX,SAVEU
IFIW+ROU
>
DEFINE MTERET (COD,EXTRA) <
JRST [EXTRA
IFNB <COD>,<MOVEI T1,COD>
TQO <ERRF>
RET]
>
;LABEL PARAMETERS
.LBRSZ==^D80 ;80 CHARACTER RECORDS
.LBLEN==^D80/4 ; # OF WORDS
.LBTDM==4 ;DATA MODE (IND COMPAT)
.LBHBW==4 ;4 BYTES/WD
.LBFRD=100 ;LABEL READ FUNCTION
.LBFWR=101 ;LABEL WRITE FUNCTION
.ACFUL=" " ;ACCESIBILITY CHARACTER ALLOWING FULL ACCESS
;LABEL FIELD CODES AND DEFINITIONS
DEFSTR (FLDPOS,,5,6) ;FIELD POSITION
DEFSTR (FLDLEN,,11,6) ;FIELD LENGTH
DEFSTR (FLDTYP,,14,3) ;FIELD TYPE CODE
DEFSTR (FLDFLG,,17,3) ;FIELD PROTECTION
DEFSTR (FLDDAT,,35,18) ;FIELD DATA ROUTINE ADDRS
FF%PRT==1 ;PROTECTED FIELD
FF%IMM==2 ;IMMEDIATE DATA
;4 - UNUSED
.FTSTR==0 ;FIELD TYPE STRING
.FTNUM==1 ;FIELD TYPE NUMBER
.FTDAT==2 ;FIELD TYPE DATE
.FTSPC==3 ;FIELD TYPE SPACES
.FTMAX==3 ;MAX VALUE OF ABOVE
DEFINE FLDID (NAM,POS,LEN,TYP,FLG,DATA) <
NAM=.
IFN <FLG&FF%IMM>,<
IFE TYP,<
BYTE (6)^D<POS>,^D<LEN> (3)TYP,FLG (18)[ASCIZ \DATA\]
>
IFN TYP,<
BYTE (6)^D<POS>,^D<LEN> (3)TYP,FLG (18)DATA
>
>
IFE <FLG&FF%IMM>,<
BYTE (6)^D<POS>,^D<LEN> (3)TYP,FLG (18)DATA
>
>
;LABEL RECORD OFFSETS IN TPLBLS
V1LOC==1 ;WORD 0 IS BLOCK HEADER
UVLOC==V1LOC+.LBLEN ;UVLD IS NEXT
H1LOC==UVLOC+.LBLEN ;THEN HDR1
H2LOC==H1LOC+.LBLEN ;THEN HDR2
;FIELDS IN LABEL DATA BASE
DEFSTR (TPFLGS,TLABR0(U),35,36) ;FLAG WORD (RESIDENT)
MSKSTR (TPVV,TLABR0(U),1B0) ;VOLUME VALID FLAG
MSKSTR (HDR1,TLABR0(U),1B1) ;HDR1 DATA VALID
MSKSTR (HDR2,TLABR0(U),1B2) ;HDR2 DATA VALID
MSKSTR (RCCHK,TLABR0(U),1B3) ;RECORD COUNT CHECK ERROR (TLRCHK)
MSKSTR (TPEOF,TLABR0(U),1B4) ;EOF1/2 SEEN IN TLRCHK (ELSE EOV)
MSKSTR (TPT20,TLABR0(U),1B5) ;THIS IS A TOPS20 VOLUME
MSKSTR (UVLD,TLABR0(U),1B6) ;UVLD DATA VALID
MSKSTR (TPRWV,TLABR0(U),1B7) ;RE-WRITE VOLUME INFO
MSKSTR (TPDOM,TLABR0(U),1B8) ;DOMESTIC VOLUME
MSKSTR (SNEOT,TLABR0(U),1B9) ;EOT SEEN WHILE WRITING LABELS
;UNUSED 10-11
DEFSTR (TPMTDM,TLABR0(U),14,3) ;PLACE TO SAVE DATA MODE
DEFSTR (TPMHBW,TLABR0(U),17,3) ;PLACE TO SAVE BYTES/WD
DEFSTR (RCNT,TLABR0(U),35,18) ;RECORD COUNT INFO (FROM UDB)
DEFSTR (TPSTAT,TLABL0(U),5,6) ;STATE CODE
DEFSTR (TPLPCS,TLABL0(U),12,7) ;LABEL PROCESSING CODE
.MXMTO==100 ;MAX MTOPR CODE (SEE MTLFCN)
;UNUSED 13-17
DEFSTR (TPUNIT,TLABL0(U),35,18) ;ACTUAL TAPE UNIT (MTA)
;UNUSED TLABL1 (0-35)
DEFSTR (TPLBLS,TLABL2(U),35,18) ;TAPE LABEL BUFFFERS IN JSB
;UNUSED 0-17
DEFSTR (FSSAV,TLABL3(U),35,36) ;PLACE TO SAVE FILSTS
DEFSTR (TPMTRS,TLABL4(U),35,18) ;PLACE TO SAVE RECORD SIZE
DEFSTR (TPFSEC,TLABL4(U),17,9) ;FILE SECTION #
;UNUSED 0-8
DEFSTR (TPLTYP,TLABL5(U),5,6) ;LABEL TYPE CODE
DEFSTR (TPFRMT,TLABL5(U),11,6) ;RECORD FORMAT TYPE CODE
DEFSTR (TPDENS,TLABL5(U),17,4) ;TAPE DENSITY (FROM MOUNT)
;UNUSED 12-13
DEFSTR (FSEQ,TLABL5(U),26,9) ;TAPE FILE POSITION (SEQ #)
DEFSTR (USRSEQ,TLABL5(U),35,9) ;USER REQUESTED SEQ #
DEFSTR (TPBSZ,TLABL6(U),17,18) ;FILE BLOCK SIZE
DEFSTR (TPRSZ,TLABL6(U),35,18) ;FILE RECORD SIZE
DEFSTR (TPEXPD,TLABL7(U),35,18) ;EXPIRATION DATE (GTAD FORMAT)
;UNUSED 0-17
DEFSTR (SVIOS,TLABL8(U),35,36) ;PLACE TO SAVE IOS
;FIELDS IN MTA DATA BASE
OPND==:1B2 ;(SEE MAGTAP)
DEFSTR (MTRS,MTANR1,35,18) ;RECORD SIZE
DEFSTR (MTDM,MTANR1,17,3) ;DATA MODE
DEFSTR (MTHBW,MTANR3,5,6) ;BYTES PER WORD
DEFSTR (MTDN,MTANR1,14,4) ;DENSITY
;LABEL DESCRIPTORS
;FORMAT OF EACH BLOCK:
; WORD 0 := -<NUMBER OF ITEMS>,,<OFFSET INTO LABEL BUFFER>
; WORD 1-N := LABEL ID WORD
; 0-5 FIELD POSITION
; 6-11 FIELD LENGTH
; 12-14 FIELD TYPE (0 = STRING, 1 = NUMBER, 2 = DATE, 3 = SPACES)
; 15-17 FLAGS (1 - PROTECTED, 2 - IMMEDIATE, 4 - UNUSED)
; 18-35 DATA OR ROUTINE ADDRS
.VOL1: -V1LEN,,V1LOC ;LOCATION IN TPLBLS
FLDID (.V1LID,1,4,.FTSTR,3,<VOL1>) ;LABEL ID
FLDID (.V1VID,5,6,.FTSTR,0,<R>) ;VOLUME ID
FLDID (.V1ACC,11,1,.FTSTR,2,< >) ;ACCESSIBILITY
FLDID (.V1OWN,38,13,.FTSTR,3,<D%KT20 00000>) ;OWNER ID
FLDID (.V1DVR,51,1,.FTSTR,3,<1>) ;DEC STD VERSION
FLDID (.V1AVR,80,1,.FTSTR,3,<3>) ;ANSI STD VERSION
V1LEN==.-.VOL1
.UVLD: -UVLEN,,UVLOC
FLDID (.UVLID,1,4,.FTSTR,3,<UVLD>) ;LABEL ID
FLDID (.UVPRT,5,6,.FTNUM,0,<GTVPRT>) ;PROTECTION
FLDID (.UVPPN,11,12,.FTNUM,2,<0>) ;TOPS10 PPN
FLDID (.UVNAM,23,39,.FTSTR,1,<GTUSER>) ;OWNERS NAME
FLDID (.UVIND,80,1,.FTSTR,3,< >) ;INDICATOR
UVLEN==.-.UVLD
.HDR1: -H1LEN,,H1LOC
FLDID (.H1LID,1,4,.FTSTR,3,<HDR1>) ;LABEL ID
FLDID (.H1FNM,5,17,.FTSTR,0,<GTFNAM>) ;FILE IDENTIFIER
FLDID (.H1VID,22,6,.FTSTR,1,<GTVLID>) ;FILE-SET ID
FLDID (.H1SEC,28,4,.FTNUM,1,<GTFSEC>) ;FILE SECTION #
FLDID (.H1SEQ,32,4,.FTNUM,1,<GTFSEQ>) ;FILE SEQUENCE NUMBER
FLDID (.H1GEN,36,4,.FTNUM,0,<GTFGEN>) ;GENERATION NUMBER
FLDID (.H1GNV,40,2,.FTNUM,0,<GTFGVR>) ;GENERATION VERSION
FLDID (.H1CRE,42,6,.FTDAT,0,<GTCDAT>) ;CREATION DATE
FLDID (.H1EXP,48,6,.FTDAT,0,<GTXDAT>) ;EXPRIATION DATE
FLDID (.H1ACC,54,1,.FTSTR,0,<GTFACC>) ;ACCESS CHARACTER
FLDID (.H1CNT,55,6,.FTNUM,3,<0>) ;BLOCK COUNT
FLDID (.H1SID,61,13,.FTSTR,3,<DECSYSTEM20>)
H1LEN==.-.HDR1
.HDR2: -H2LEN,,H2LOC
FLDID (.H2LID,1,4,.FTSTR,3,<HDR2>) ;LABEL ID
FLDID (.H2FMT,5,1,.FTSTR,0,<GTRFMT>) ;RECORD FORMAT
FLDID (.H2BLN,6,5,.FTNUM,0,<GTBLEN>) ;BLOCK LENGTH
FLDID (.H2RLN,11,5,.FTNUM,0,<GTRLEN>) ;RECORD LENGTH
FLDID (.H2PRT,38,6,.FTNUM,0,<GTFPRT>) ;PROTECTION
FLDID (.H2PAD,48,1,.FTSTR,2,<^>) ;PADDING CHARACTER
FLDID (.H2BSZ,49,2,.FTNUM,2,<GTFBSZ>) ;FILE BYTE SIZE
FLDID (.H2OFS,51,2,.FTNUM,2,<0>) ;BUFFER OFFSET?
H2LEN==.-.HDR2
;STATE CODES
; CLS ;DEVICE IS CLOSED
; HDR ;READ/WRITE HDRS
; UHL ;USER HEADER LABEL AREA
; RDY ;DEVICE IS READY FOR I/O
; EOF ;END OF FILE SECTION
; EOT ;EOT MARKER SEEN ON OUTPUT
; ETL ;READ/WRITE TRAILERS
; UTL ;TLRS PROCESSED, ALLOW UTL
;MACRO TO GENERATE STATE CODE DISPATCH TABLES
DEFINE STDISX (TYP,LST) <
IRP <LST>,< ;;GEN STATES
IF2,<IFNDEF TYP'.'LST,<TYP'.'LST=BADIS>>
IFIW!'TYP'.'LST ;;DISPATCH
>
>
;MACRO TO GENERATE STATE CODES
DEFINE GENST (LIST) <
.NSTAT==-1 ;;INIT COUNT OF STATES
IRP <LIST>,<
.NSTAT==.NSTAT+1 ;;INCR STATE CODE
.ST'LIST==.NSTAT ;;ASSIGN STATE CODE
>
;;MAKE MACRO TO GEN DISPATCH
DEFINE STDIS (TYP) <
STDISX (TYP,<LIST>) ;; CALL INNER MACRO
>
>
;NOW GENERATE THE STATES
GENST (<CLS,HDR,UHL,RDY,EOF,EOT,ETL,UTL>)
;PULSAR MESSAGE DEFINITIONS
;MESSAGE CODES
.PRABT==1 ;ABORT MESSAGE
.PRICN==2 ;INTERNAL CONFUSION
.PRERR==3 ;LABEL R/W ERROR
.PREVR==4 ;END-OF-VOLUME WHILE READING
.PREVW==5 ;END-OF-VOLUME WHILE WRITING
;DISPATCH TABLE FOR TAPES (MT'S)
SWAPCD
MTDTB:: DTBBAD (DESX9) ;SET DIRECTORY
DTBBAD (DESX9) ;LOOKUP NAME
DTBBAD (DESX9) ;LOOKUP EXTENSION
DTBDSP (MTVER) ;LOOKUP VERSION
DTBBAD (DESX9) ;PROTECTION INSERTION
DTBBAD (DESX9) ;ACCOUNT INSERTION
DTBBAD (DESX9) ;STATUS INSERTION
DTBDSP (MTOPN) ;OPNEF
DTBDSP (MTSQI) ;BIN/SIN
DTBDSP (MTSQO) ;BOUT/SOUT
DTBDSP (MTCLZ) ;CLOSF
DTBBAD (DESX9) ;RENAME
DTBBAD (DESX9) ;DELETE
DTBDSP (MTDI) ;DUMPI
DTBDSP (MTDO) ;DUMPO
DTBSKP ;MOUNT
DTBSKP ;DISMOUNT
DTBBAD (DESX9) ;INIT DIRECTORY
DTBDSP (MTMT) ;MTOPR
DTBDSP (MTGTSX) ;GETSTS
DTBDSP (MTSTSX) ;SETSTS
DTBDSP (MTRCO) ;RECORD OUT
DTBDSP (RFTADN) ;READ TAD
DTBDSP (SFTADN) ;SET TAD
DTBDSP (BIOINP) ;SET JFN FOR INPUT
DTBDSP (BIOOUT) ;SET JFN FOR OUTPUT
DTBBAD (GJFX49) ;CHECK ATTRIBUTE
DTBLEN==:.-MTDTB ;GLOBAL LENGTH OF DISPATCH TABLE
;TEMPORARY DUMMIES
MTVER: MOVEI T1,0
RETSKP
MTGTSX: ASUBR <SAV1,SAV2,SAV3,SAV4>
CALL SETUNT ;SETUP UNIT
RET ;ERROR OR NEED TO BLOCK
UCALL MTGTS
RET
MTSTSX: ASUBR <SAV1,SAV2,SAV3,SAV4>
CALL SETUNT
RET
UCALL MTSTS,<SAV1>
RET
MTRCO: ASUBR <SAV1,SAV2,SAV3,SAV4>
CALL SETUNT
RET
MOVE T3,SAV3 ;PASS DOWN
UCALL MTRECO
RET
RETSKP
MTMT: ASUBR <SAV1,SAV2,SAV3,SAV4>
CALL SETUNT ;UNIT SETUP
RET
MOVE T2,SAV2 ;FUCTION CODE
UCALL MTMTAP ;TO MTAPE
MOVE T3,SAV3 ;BLOCK CO-ROUTINE
RET
RETSKP
;ROUTINE TO OPEN A TAPE (CHECK FOR VOLUME VALID)
MTOPN: ASUBR <SAV1,SAV2,SAV3,SAV4>
CALL SETUNT ;SET UNIT INFO
RET ;ERROR OR NEED TO BLOCK
CALLRET OPEN ;CONTINUE WITH OPEN PROCESSING
;ROUTINE TO CHECK ACTUAL MTA UNIT # AND CHECK VOLUME VALID
;MT UNIT TO RHS(U), MTASTS TO IOS
SETUNT: HLRZ U,DEV ;GET MT UNIT NUMBER
LOAD T1,TPUNIT ;GET MTA UNIT #
CAIN T1,-1 ;-1 MEANS NO UNIT ASSIGNED
MTERET (OPNX8) ;ERROR RETURN
JE TPVV,,[MTERET (OPNX8)] ; OR NOT VV
JN TPLPCS,,SETERR ;UNIT ACTIVE - ABORT AND RETURN ERROR
MOVE IOS,MTASTS(T1) ;RETURN IOS OF MTA
RETSKP ;SUCCESS RETURN
;SEQUETIAL INPUT JACKET ROUTINE
MTSQI: ASUBR <SAV1,SAV2,SAV3,SAV4>
CALL SETUNT ;SETUP UNIT INFO
RET ;ERROR OR BLOCK
CALL INCHK ;CHECK INPUT SETUP
RET
MOVE T3,SAV3 ;PASS DOWN BLOCK ROUTINE
UCALL MTASQI ;PERFORM ACTUAL BUFFER FILL
TQNN <EOFF> ;END OF FILE?
RET ;NO - RETURN
CALLRET EOV ;YES - EOV PROCESSING
;ROUTINE TO CHECK TAPE POSTION FOR INPUT
INCHK: LOAD T1,TPSTAT ;GET MT STATE CODE
JRST @INDIS.(T1) ;DISPATCH ON STATE CODE
;DISPATCH TABLE FOR INCHK
INDIS.: STDIS (IN) ;GEN DISPATCH FOR STATES
;HERE IF NOT OPENED YET (IE HDRS NOT READ)
IN.CLS:
IN.HDR: CALL OPEN ;RE-OPEN (READ HEADERS)
RET ;ERROR OR BLOCK
JRST INCHK ;PROCEED
;IN UHL AREA - SKIP TO EOF
IN.UHL: MOVEI T2,.MOFWF ;SKIP FORWARD FILE
CALL MTLFCN ;INIT FUNCTION
RET ;BLOCK OR ERROR
CALLRET SETRDY ;SET READY AND RCNT
;TAPE IS READY FOR INPUT
IN.RDY: RETSKP ;SKIP RETURN FOR NOW
;HERE IF TAPE WASNT CLOSED
IN.UTL: CALL CLOSE ;FINISH CLOSE
RET ;BLOCK
JRST INCHK ;CONTINUE
;SEQUENTIAL OUTPUT JACKET
MTSQO: ASUBR <SAV1,SAV2,SAV3,SAV4>
CALL SETUNT ;SETUP UNIT INFO
RET
CALL OUTCHK ;CHECK OUTPUT SETUP
RET ;PASS UP
MOVE T3,SAV3 ;PASS DOWN ROUTINE ADDRS
UCALL MTASQO,<SAV1> ;WRITE BYTE
TQNE <ERRF> ;ERROR (MAYBE EOT)
TXNN IOS,MT%EOT ;EOT?
RET ;NO - RETURN
CALLRET EOV ;YES - HANDLE
;ROUTINE TO CHECK OUTPUT TAPE POSITION
OUTCHK: LOAD T1,TPSTAT ;GET STATE
JRST @OUDIS.(T1) ;DISPATCH
;DISPATCH TABLE FOR OUTPUT
OUDIS.: STDIS (OU) ;GEN FOR ALL STATES
;TAPE NOT OPENED (HEADERS WRITTEN)
OU.CLS:
OU.HDR: CALL OPEN ;FINISH OPEN PROCESS
RET ;BLOCK OR ERROR
JRST OUTCHK ;MORE CHECKING
;USER LABELS DONE - TIE OFF LABEL AREA
OU.UHL: MOVEI T2,.MOEOF ;WRITE A TAPE MARK
CALL MTLFCN ;...
RET ;RETURN TO BLOCK
TXNN IOS,MT%EOT ;EOT HERE?
JRST SETRDY ;NO - READY THEN
SETONE SNEOT ;YES - REMEMBER THAT
SETRDY: MOVEI T1,.STRDY ;READY FOR I/O
STOR T1,TPSTAT
CALL CLREOF ;CLEAR EOF INDICATION
LOAD T1,TPUNIT ;GET MTA UNIT
CALL PHYPOS ;GET POSITION INFO
STOR T1,RCNT ;SAVE FOR CLOSE
JN SNEOT,,EOV ;PROCESS EOV IF EOT SEEN
RETSKP ;SKIP RETURN
;TAPE READY FOR OUTPUT
OU.RDY: RETSKP ;SKIP RETURN
;HERE IF PREVIOUS USE WASN'T CLOSED
OU.UTL: CALL CLOSE ;FINISH CLOSE
RET
JRST OUTCHK ;CONTINUE PROCESSING
;ROUTINE TO CLEAR EOFF AND MT%EOF
CLREOF: LOAD T1,TPUNIT ;GET MTA UNIT #
MOVX IOS,MT%EOF!MT%EOT ;BITS TO CLEAR
ANDCAB IOS,MTASTS(T1) ;CLEAR
TQZ <EOFF,ERRF> ; THIS ALSO
RET ; AND RETURN
;BAD STATE DISPATCHES COME HERE
BADIS: BUG (CHK,BADDIS,<TAPE: INCONSISTENT STATE CODE>)
SETZRO TPVV ;CLEAR VOLUME VALID
MOVEI T1,.PRICN ;INTERNAL CONFUSION
CALL PLRMSG
MTERET (IOX69) ;RETURN ERROR
;DUMP MODE I/O
MTDI: ASUBR <SAV1,SAV2,SAV3,SAV4>
CALL SETUNT ;SETUP U, ETC...
RET ;PASS ERROR UP (OR BLOCK)
CALL INCHK ;CHECK FOR INPUT
RET ;NEED TO BLOCK
MOVE T3,SAV3 ;PASS DOWN ROUTINE ADDRS
UCALL MTDMPI,<SAV1> ;CALL UPON MAGTAP
JRST MTDIW ;BLOCK OR ERROR OR EOF
RETSKP ; OK RETURN
MTDIW: TQNN <EOFF> ;END-OF-FILE?
RET ;NO - BLOCK OR ERROR
CALLRET EOV ;HANDLE TAPE MARK
MTDO: ASUBR <SAV1,SAV2,SAV3,SAV4>
CALL SETUNT ;SETUP U
RET ;BLOCK ETC...
CALL OUTCHK ;CHECK FOR OUTPUT
RET
MOVE T3,SAV3 ;BLOCK ROUTINE ADDRS
UCALL MTDMPO,<SAV1> ;DO OUTPUT
JRST MTDOW ;BLOCK OR CHECK EOT
RETSKP ;OK RETURN
MTDOW: TXNN IOS,MT%EOT ;THIS EOT?
RET ;NO - ERROR RETURN
CALLRET EOV ;YES - EOV PROCESSING
;ROUTINE TO CLOSE A TAPE
MTCLZ: ASUBR <SAV1,SAV2,SAV3,SAV4>
TXNE T1,CZ%ABT ;CLOSE W/ABORT?
JRST MTCLZA ;YES - HANDLE SPECIAL
CALL SETUNT ;NO - PROCEED NORMALLY
RET ;BLOCKAGE
CALL CLOSE ;PERFORM CLOSEING OPERATIONS
RET ;BLOCK OR ERROR
RETSKP ;CLOSED NOW
;HERE IF CLOSE WITH ABORT
MTCLZA: SETZRO TPLPCS ;ABORT LABEL PROCES IF ANY
HLRZ U,DEV ;SETUP U
LOAD T1,TPUNIT ;GET MTA UNIT #
CAIN T1,-1 ;VALID?
MTERET (OPNX8) ;NO - OFF LINE
MOVE IOS,MTASTS(T1) ;OK - SETUP IOS
MOVE T3,SAV3 ;BLOCK ADDRS
UCALL MTACLZ,<SAV1> ;CALL UPON MAGTAP
RET ;ERROR (NEVER BLOCK)
LOAD T2,TPLBLS ;RETURN BLOCK
JUMPE T2,MTCLA1 ;DO NOTHING IF ZERO
MOVEI T1,JSBFRE ; IN JSB
CALL RELFRE ;...
SETZRO TPLBLS ;CLEAR THIS
MTCLA1: MOVEI T1,.STCLS ;MARK UNIT CLOSED
STOR T1,TPSTAT
SETZRO TPVV ;CLEAR VOLUME VALID
MOVEI T1,.PRABT ;ABORT MESSAGE
CALL PLRMSG ;NOTIFY PULSAR
RETSKP ;RETURN
;ROUTINE TO PERFORM FUNCTION CODE IN T2 AND WAIT UNTIL
; IT IS COMPLETE (CHECK ERRORS)
;RETURNS ERROR CODE (IF ANY) IN T1
MTLFCN: STOR T2,TPLPCS ;REMEMBER FCN STARTED
TQO <OPNF> ;ALWAYS TO BE OPENED!
CAIL T2,.MXMTO ;MAX MTOPR FUNCTION
JRST MTFCN2 ;DOING OTHER FUNCTION
MOVE T3,SAV3 ;PASS THIS DOWN
UCALL MTMTAP ;ATTEMPT FUNCTION IN T2
JRST MTFCNB ;BLOCK OR ERROR
MTFCNW: LOAD T2,TPLPCS ;FUNCTION JUST PERFORMED
SETZRO TPLPCS ;CLEAR FIELD
CAIN T2,.MONOP ;WAS THAT THE WAIT?
JRST MTFCND ;DONE - PERFORM STATE CHANGE
MOVEI T2,.MONOP ;DO NO-OP (WAIT)
JRST MTLFCN ;...
MTFCND: ;*** RETURN STATUS UPDATE ***
LOAD T1,TPSTAT ;CHECK FOR FUNNY OPNF STATE
CAIN T1,.STHDR ; IS IT?
TQZ <OPNF> ;CLEAR THIS IF NOT OPENED
RETSKP ;DONE RETURN
;BLOCK ROUTINE / CHECK OPNF BIT STATE
;C(T1) PRESERVED (ERROR CODE/ WAIT STATE)
MTFCNB: LOAD T2,TPSTAT ;GET STATE
CAIN T2,.STHDR ;OPENED?
TQZ <OPNF> ;NO - MAKE SURE
TQZN <BLKF> ;CHECK FOR ERROR
RET ;NOT BLOCKING
MOVE T2,SAV4 ;RETURN JFN TO BLOCK ROUTINE
CALL @SAV3 ;PERFORM BLOCK ROUTINE
MTERET () ;ERROR
LOAD T2,TPLPCS ;TRY FUNCTION OVER
JRST MTLFCN ;...
;NON MTOPR FUNCTIONS ARE HANDLED HERE
MTFCN2: CAILE T2,.MXFCN ;VALID FUCNTION?
BUG (HLT,MTFCNX,<MTLFCN: FUNCTION CODE TOO LARGE>)
JRST @FCNTB-.MXMTO(T2) ;YES - DISPATCH
FCNTB: DTBDSP (LRFCN) ;100 - LABEL READ
DTBDSP (LWFCN) ;101 - LABEL WRITE
.MXFCN==.-FCNTB+.MXMTO-1
LRFCN: CALL LBLRED ;START I/O
JRST MTFCNB ;BLOCK OR ERROR
JRST MTFCNW ;DO WAIT FCN
LWFCN: CALL LBLWRT ;START I/O
JRST MTFCNB ;BLOCK OR ERROR
JRST MTFCNW ;DO WAIT FCN
;EOV ROUTINE - HANDLE TM ON READ OR EOT ON WRITE
EOV: SETZRO SNEOT ;DONE WITH THIS FLAG
EOV1: LOAD T1,TPSTAT ;GET STATE
TQNE <WRTF> ;WRITING?
JRST @EWDIS.(T1) ;YES - DISPATCH
JRST @ERDIS.(T1) ;NO - READING
EWDIS.: STDIS (EW) ;GEN STATES (WRITE)
ERDIS.: STDIS (ER) ;GEN STATES (READ)
;READ - MUST BE READY
ER.RDY: CALL CLREOF ;CLEAR EOF
MOVEI T1,.STEOF ;SAY EOF SEEN
STOR T1,TPSTAT ;...
JRST EOV1 ;LOOP BACK
;READ TRAILERS
ER.EOF: CALL TLRCHK ;READ/CHECK TRAILERS
RET ;PASS ERROR UP
MOVEI T1,.STUTL ;SET FOR USER TRAILERS
STOR T1,TPSTAT
JE TPEOF,,EREOF1 ;JUMP IF EOV
LOAD T1,TPUNIT ;GET MTA UNIT #
MOVX IOS,MT%EOF ;SET EOF
IORB IOS,MTASTS(T1) ;...
TQO <EOFF> ;RETURN END-OF-FILE
RET
;HERE TO HANDLE EOV ON READ
EREOF1: MOVEI T1,.PREVR ;INFORM PULSAR
CALL PLRMSG ; TO OBTAIN NEXT UNIT
;*** INT USER FOR UTL ***
VVBLOK: SETZRO TPVV ;CLEAR VOLUME VALID
MOVEI T1,VVBWAT ;SCHED TEST ADDRS
HRL T1,U ;UNIT TO WAIT FOR
MDISMS ;*** HANDLE LOCKED JFN , ETC ***
RET ;RETURN
RESCD
;SCHEDULER TEST FOR WAITING FOR PULSAR TO RESET V/V
VVBWAT: PUSH P,U ;SAVE U
MOVE U,T1 ;COPY UNIT # TO U
JN TPVV,,VVBDON ;DONE IF NON-ZERO
POP P,U ;RESTORE U
JRST 0(4) ;WAIT SOME MORE
VVBDON: POP P,U ;RESTORE
JRST 1(4) ;WAKE JOB
SWAPCD
;WRITE - CHECK READY
EW.RDY: CALL CLREOF ;CLEAR EOT/EOF
MOVEI T2,.MOEOF ;WRITE FINAL TAPE MARK
CALL MTLFCN ;...
RET ;BLOCK
CALL CLREOF ;CLEAR EOF INFO
MOVEI T1,.STEOT ;CHANGE TO EOT STATE
STOR T1,TPSTAT ;...
JRST EOV1 ;CONTINUE
EW.EOT: HRROI T1,[ASCIZ "EOV1"] ;USE END-OF-VOLUME LABELS
HRROI T2,[ASCIZ "EOV2"]
CALL WRTTLR ;WRITE TRAILERS
RET ;PASS ERROR UP
INCR TPFSEC ;INCREMENT SECTION NUMBER
SETZRO <HDR1,HDR2> ;NO MORE HEADERS
MOVEI T1,.STUTL ;PROCEED TO USER TRAILERS
STOR T1,TPSTAT ;...
JRST EOV1 ;CONTINUE
EW.UTL: MOVEI T2,.MOEOF ;WRITE FINAL TAPE MARK
CALL MTLFCN
RET ;BLOCK OR ERROR
CALL CLREOF ;CLEAR EOT
MOVEI T1,.PREVW ;INFORM PULSAR TO OBTAIN NEXT UNIT
CALL PLRMSG
JRST VVBLOK ;HANDLE VV/WAIT
;OPEN PROCESSING
OPEN: LOAD T1,TPSTAT ;GET STATE CODE
JRST @OPDIS.(T1) ;OPEN DISPATCH
;OPEN DISPATCH TABLE
OPDIS.: STDIS (OP) ;OPEN TABLE
;OPEN PROCESSING - CLOSED STATE
OP.CLS: UCALL MTAOPN ;PERFORM ACTUAL OPEN
RETBAD () ;ERROR OCCURED
JN TPLBLS,,OPCLS1 ;HAVE AREA?
MOVEI T2,4*.LBLEN+1 ;ALLOCATE JSB SPACE FOR LABELS
CALL ASGJFR
RETBAD () ;NO SPACE
STOR T1,TPLBLS ;SAVE ADDRS
OPCLS1: MOVEI T1,.STHDR ;OK - MOVE TO HEADER STATE
STOR T1,TPSTAT ;...
SETZRO FSSAV ;NO STATUS SAVED YET
JRST OPEN ; AND PROCEDE
;OPEN FILE PROCESSING - CHECK/WRITE HEADERS
OP.HDR: JN USRSEQ,,OPHDR1 ;USER SPECIFIED SEQ #?
MOVEI T1,1 ;NO - SUPPLY 1
STOR T1,USRSEQ ;...
OPHDR1: LOAD T3,TPUNIT ;GET MTA UNIT #
LOAD T1,MTDN,(T3) ;GET VOLUME TAPE DENSITY
LOAD T2,TPDENS ;GET USER REQUESTED DENSITY
CAME T1,T2 ;MATCH?
JRST [ JUMPE T2,[STOR T1,TPDENS ;SET DEFAULT
JRST OPHD1B]
LOAD T1,USRSEQ ; LOAD USER REQUESTED SEQ #
TQNE <WRTF> ;NO - WANT TO WRITE?
CAIE T1,1 ; AND REQUESTS FIRST FILE
MTERET (IOX69) ;CANT MISMATCH DENSITIES
SETONE TPRWV ;SET TO RE-WRITE VOLUME LABELS
JRST .+1]
OPHD1B: JN FSEQ,,OPHDR2 ;SKIP FOLLOWING IF WE KNOW WHERE WE ARE
OPHD1A: CALL HDRCHK ;READ AND CHECK HEADERS
RET ;BLOCK OR ERROR
OPHDR2: LOAD T1,FSEQ ;GET TAPE FILE POS
OPSTR <SUB T1,>,USRSEQ ;GET DIFFERENCE FROM USER REQUEST
JUMPN T1,[CALL SKPFIL ;SKIP "N" FILES
RET ;BLOCK
JRST OPHD1A] ;LOOK AT HEADERS
;WE SHOULD BE AT THE CORRECT FILE NOW
JN HDR1,,OPHD2A ;JUMP IF ALREADY HAVE HEADERS
CALL HDRCHK ;NO - READ AND CHECK HEADERS
RET ;BLOCK OR ERROR
OPHD2A: TQNN <WRTF> ;WRITING?
JRST OPHDRD ;NO - READ ONLY CASE
JRST OPHDWR ;YES - HANDLE WRITE/READ
;OPEN FOR WRITE ACCESS (CHECK READ ALSO)
OPHDWR: JE HDR1,,OPHDW3 ;IF NO HEADER - THEN APPEND ALLOWED
MOVE T2,.H1ACC ;GET ACCESS CHAR
MOVEI T3,H1LOC ;FROM HDR1
CALL GETLBL
JFCL
CAIN T1,.ACFUL ;FULL ACCESS?
JRST OPHDW1 ;YES - ACCESS GRANTED
JE TPDOM,,[MTERET (IOX69)] ;ERROR IF NOT DOMESTIC
JE HDR2,,[MTERET (IOX69)] ; OR NO HDR2 TO CHECK
;*** CHECK PROTECTION FIELD ***
OPHDW1: MOVE T2,.H1EXP ;GET EXPIRATION D/T
MOVEI T3,H1LOC ;FROM HDR1
CALL GETLBL ;...
RET ;FIELD ERROR
PUSH P,T1 ;SAVE DATE
CALL LGTAD ;GET SYSTEM DATE
HLRZS T1
POP P,T2 ;FILE EXPIRATION TO T2
CAMGE T1,T2 ;EXPIRED?
MTERET (IOX69) ;YES - RETURN ERROR
TQNE <READF> ;OK - READING ALSO?
JRST [ JN TPRWV,,[MTERET (IOX69)] ;ERROR IF WRONG DENSITY
JRST OPHDON] ;ELSE DONE
JN TPRWV,,OPHDW2 ;CHECK FOR VOLUME REWRITE
LOAD T1,FSEQ ;SEE IF WRITING FIRST FILE
CAIE T1,1 ; ON VOLUME
JRST OPHDW3 ;NO - JUST DO HEADERS
OPHDW2: MOVEI T2,.MOREW ;REWIND TAPE
CALL MTLFCN ;...
RET
LOAD T2,TPUNIT ;SET UP UNIT #
LOAD T1,TPDENS ;SET TAPE DENSITY
STOR T1,MTDN,(T2) ;...
MOVEI T1,V1LOC ;GET VOLUME LABEL
CALL FETLBL
MOVEI T2,.LBFWR ;WRITE IT ON TAPE
CALL MTLFCN ;...
RET ;BLOCK OR ERROR
JN UVLD,,OPHW2A ;HAVE 2ND VOL LABEL?
MOVEI T1,.UVLD
CALL MAKLBL ;MAKE A UVLD LABEL
MTERET ()
SETONE UVLD ;HAVE ONE NOW
OPHW2A: MOVEI T1,UVLOC ;GET 2ND VOL
CALL FETLBL ;...
MOVEI T2,.LBFWR ;WRITE IT
CALL MTLFCN
RET
SETZRO <HDR1,HDR2> ;FOR REPOSITIONING
;..
;..
;NOW WRITE FILE HEADER LABELS
OPHDW3: CALL REPOS ;REPOSITION IF NECESSARY
RET ;BLOCK OR ERROR
MOVEI T1,1 ;SET UP SECTION #
STOR T1,TPFSEC ;...
MOVEI T1,.HDR1 ;LABEL TYPE
CALL MAKLBL
MTERET ()
SETONE HDR1
MOVEI T1,H1LOC ;NOW GET LABEL
CALL FETLBL
MOVEI T2,.LBFWR ;WRITE FUNCTION
CALL MTLFCN ;WRITE IT
CALL OPNEOT ;CHECK FOR EOT
MOVEI T1,.HDR2 ;2ND HEADER TYPE
CALL MAKLBL
MTERET ()
SETONE HDR2
MOVEI T1,H2LOC ;GET HDR2 INTO BUFFER
CALL FETLBL
MOVEI T2,.LBFWR
CALL MTLFCN ;WRITE IT ALSO
CALL OPNEOT ;CHECK FOR EOT
;HERE WHEN FILE HAS BEEN OPENED
OPHDON: MOVEI T1,.STUHL ;MOVE TO USER HEADER STATE
STOR T1,TPSTAT
JRST OPEN ;CONTINUE PROCESSING
;OPEN PROCESSING - USER HEADER STATE
OP.UHL: RETSKP ;JUST SKIP RETURN
;EOT SEEN WHILE WRITING HEADERS
OPNEOT: TXNN IOS,MT%EOT ;IS IT REALLY?
JRST [ ADJSP P,-1 ;CLEAN STACK
RET] ;ERROR RETURN
CALL CLREOF ;CLEAR IT
SETONE SNEOT ; AND REMEMBER
RET ;CONTINUE
;OPEN FOR READ ONLY ACCESS
OPHDRD: MOVE T2,.H1ACC ;GET ACCESS CHAR
MOVEI T3,H1LOC ;FROM HDR1
CALL GETLBL
JFCL
CAIN T1,.ACFUL ;CHECK FULL ACCESS
JRST OPHDON ;DONE IF OK
;*** MORE PROTECTION CHECKS ***
JRST OPHDON ;DONE
;LABEL MAKING ROUTINES
;CALL MAKLBL WITH C(T1) := ADDRS OF PARAMETER TABLE FOR LABEL
MAKLBL: ASUBR <VAL,DESC,BFR,PNTR>
SAVEQ ;SAVE Q1-Q3
HLL T1,0(T1) ;FORM AOBJN PNTR
MOVE Q3,T1 ;SAVE IN Q3
HRRZ IOS,0(T1) ;BUFFER OFFSET ARG
MOVEM IOS,BFR ; SAVE BFR PNTR
CALL SPACES ;PREFILL WITH SPACES
JRST MAKNXT ;START PROCESSING FIELDS
MAKLUP: MOVE T2,0(Q3) ;GET FIELD DESCRIPTOR
MOVEM T2,DESC ;SAVE
MOVEM IOS,BFR ;RESET BFR PNTR
CALL MAKEBP ;FORM BP TO FIELD (IN PNTR)
LOAD T1,FLDDAT,DESC ;ROUTINE ADDRS FOR FIELD DATA
LOAD T2,FLDFLG,DESC ;GET FLAGS
TRNE T2,FF%IMM ;IMMEDIATE VALUE?
JRST [ LOAD T3,FLDTYP,DESC ;GET TYPE
CAIN T3,.FTSTR ;STRING?
TLO T1,-1 ;YES - FORM PNTR
JRST MAKLP1]
CALL @T1 ;FETCH DATA TO T1
MAKLP1: MOVEM T1,VAL ;SAVE AS VALUE
LOAD T4,FLDLEN,DESC ;GET LENGTH TO T4
LOAD T2,FLDTYP,DESC ;DISPATCH ON FIELD TYPE
CAILE T2,.FTMAX
JRST ILLTYP ;ILLEGAL TYPE FIELD
CALL @[ MAKSTR ;STRING
MAKNUM ;NUMBER
MAKDAT ;DATE
MAKSPC](T2) ;SPACES
RETBAD (IOX69)
MAKNXT: AOBJN Q3,MAKLUP ;LOOP OVER ALL FIELDS
RETSKP ;RETURN
;FILL FIELD WITH SPACES
MAKSPC: MOVEI T2," " ;SPACE
IDPB T2,PNTR ;STORE CHAR
SOJG T4,.-1
RETSKP ;RETURN
;ROUTINE TO FILL LABEL FIELD WITH STRING
;C(T1) := STRING PNTR , C(T4) := LENGTH
MAKSTR: MOVE T1,VAL ;GET STRING PNTR
TLC T1,-1 ;CHECK FOR SPECIAL
TLCN T1,-1 ; STRING POINTER
HRLI T1,(POINT 7,,) ;CONVERT IF NECESSARY
MAKST1: ILDB T3,T1 ;FETCH CHAR
JUMPE T3,MAKSPC ;DONE WHEN NULL SEEN (PAD W/SPACES)
IDPB T3,PNTR ;PUT CHAR
SOJG T4,MAKST1 ;LOOP
RETSKP ;GOOD RETURN (MAY TRUNCATE)
;ROUTINE TO FILL FIELD WITH NUMBER
MAKNUM: MOVE T2,VAL ;GET VALUE INTO T2
MOVE T1,PNTR ;SETUP POINTER
CALL PNOUT ;NUMBER W/ LEADING ZEROS
RETSKP ;GOOD RETURN
;ROUTINE TO PUT DATE IN LABEL FIELD
MAKDAT: MOVEI T1," " ;NEED LEADING SPACE
IDPB T1,PNTR ;...
MOVE T2,VAL ;GET DATE VALUE
MOVX T4,IC%JUD ;CONVERT TO JULIAN
ODCNV
MOVE T1,PNTR ;PICK UP POINTER
MOVEM T2,VAL ;SAVE DAY-OF-YEAR
HLRZS T2 ;GET YEAR
SUBI T2,^D1900 ;NORMALIZE TO 20TH CENTURY
MOVEI T4,2 ;2 CHARACTERS
CALL PNOUT ; OUTPUT NUMBER
HRRZ T2,VAL ;GET DAY
MOVEI T4,3 ;3 CHARS
CALL PNOUT ;OUTPUT IT (PNTR IN T1)
RETSKP ;OK - RETURN
;ROUTINE TO PRE-FILL LABEL RECORD WITH SPACES
SPACES: MOVE T1,BFR ;GET BUFFER ADDRS
JUMPGE T1,[LOAD T2,TPLBLS ;OFFSET INTO LABEL STG
ADD T2,T1
JRST SPAC1]
HRRZ T2,U ;-1 := USE TLABBF
IMULI T2,.LBLEN
ADDI T2,TLABBF ;...
SPAC1: MOVE T1,[BYTE (8)40,40,40,40]
MOVEM T1,0(T2) ;FILL FIRST WORD
HRLZ T1,T2 ;FORM FROM,,TO
HRRI T1,1(T2)
BLT T1,.LBLEN-1(T2) ;PROPAGATE
RET ;RETURN
;ROUTINE TO PUT A NUMBER WITH LEADING ZERO FILL INTO A FIELD
;C(T1) := POINTER
;C(T2) := NUMBER (BASE 10.)
;C(T4) := LENGTH
PNOUT: SKIPN T2 ;DONE ON ZERO
TDZA T3,T3 ;SUPPLY A 0
IDIVI T2,^D10 ;DIVIDE BY 10.
HRLM T3,0(P) ;SAVE REMAINDER
SOJLE T4,PNOUT1 ;DECR COUNT
CALL PNOUT ;RECURSE
PNOUT1: HLRZ T3,0(P) ;GET BACK DIGIT
ADDI T3,"0" ;CONVERT TO ASCII
IDPB T3,T1 ;STORE CHAR
RET ;RETURN
;ROUTINE TO SETUP A SPECIFIED LABEL FIELD
;C(T1) := VALUE
;C(T2) := DESCRIPTIO
;C(T3) := BUFFER PNTR
SETLBL: ASUBR <VAL,DESC,BFR,PNTR>
CALL MAKEBP ;SETUP PNTR
LOAD T4,FLDLEN,DESC ;GET LENGTH
LOAD T2,FLDTYP,DESC ;DISPATCH ON TYPE CODE
CAIG T2,.FTMAX
JRST @[ MAKSTR ;STRING
MAKNUM ;NUMBER
MAKDAT ;DATE
MAKSPC](T2) ;SPACES
JRST ILLTYP ;ILLEGAL TYPE CODE
;PARAMETER SETUP ROUTINES
;ROUTINE TO RETURN TAPE BLOCK SIZE
GTBLEN: LOAD T1,TPBSZ ;GET USER SPECIFIED SIZE
JUMPE T1,GTDFRC ;USE DEFAULT IF ZERO
RET ;RETURN
;RETURN FILE RECORD SIZE
GTRLEN: LOAD T1,TPRSZ ;GET USER SPECIFIED SIZE
JUMPE T1,R ;RETURN IF NON-ZERO
GTDFRC: MOVEI T1,4*MTDFRS ;NONE - SUPPLY DEFAULT
LOAD T2,TPFRMT ;GET FORMAT TYPE
CAIGE T2,4 ;CHECK FOR UNDEFINED
CAIL T2,1 ;...
SKIPA T1,[MTDFRS] ;UNDEFINED - CHECK MODE
RET ;ASCII - RETURN NOW
LOAD T2,TPUNIT ;GET MTA UNIT
OPSTR <IMUL T1,>,MTHBW,(T2) ;COMPUTE HARDWARE BYTES/WORD
RET
;RETURN RECORD FORMAT INFO
GTRFMT: LOAD T1,TPFRMT ;GET FORMAT CODE
HRROI T1,FMTTAB(T1) ;MAKE STRING PNTR
RET
FMTTAB: ASCIZ "U" ;0 - DEFAULT (UNDEFINED)
ASCIZ "F" ;1 - FIXED
ASCIZ "D" ;2 - VARIABLE
ASCIZ "S" ;3 - SPANNED
ASCIZ "U" ;4 - UNDEFINED
;RETURN CREATION/EXPIRATION DATE
GTXDAT: LOAD T1,TPEXPD ;GET EXP DATE
SKIPN T1 ;ANY DEFINED?
GTCDAT: SETO T1, ;NO - SUPPLY TODAY
RET
;RETURN FILE ACCESS CHARACTER
GTFACC: HRROI T1,[ASCIZ "1"] ;USE THIS FOR NOW
RET
;RETURN FILE PROTECTION
GTVPRT: ;DEFAULT VOLUME PROTECTION
GTFPRT: MOVE T1,[^D777700] ;DEFAULT PROT FOR NOW
RET
;RETURN FILE NAME FROM GTJFN OR GENERATE ONE
GTFNAM: HLRO T1,FILNEN(JFN) ;POINTER TO NAME STRING
SKIPE 1(T1) ;NULL?
AOJA T1,R ;NO - ADJUST AND RETURN
HRRZ T2,T1 ;YES - FREE UP BLOCK
MOVEI T1,JSBFRE
CALL RELFRE ;...
MOVEI T2,6 ;GET SIX WORD BLOCK
CALL ASGJFR ; (17 CHARS + HEADER)
RETBAD ()
HRLM T1,FILNEN(JFN) ;SAVE BLOCK ADDRS
ADD T1,[POINT 7,1] ;FORM BYTE PNTR
MOVEM T1,VAL ;SAVE
CALL VOLID2 ;RETURN VOLID PNTR IN T2
MOVEI T4,6 ;MAX SIZE
GTFNM1: ILDB T3,T2 ;GET CHAR (8-BIT)
CAIN T3," " ;DONE ON SPACE
JRST GTFNM2
IDPB T3,T1 ;COPY TO STRING (7-BIT)
SOJG T4,GTFNM1 ;DO 6
GTFNM2: HRROI T2,[ASCIZ "-FILE-"]
SETZ T3,
SOUT ;APPEND TO VOLID
LOAD T2,FSEQ ;GET SEQUENCE NUMBER
MOVEI T4,4 ;4 CHARS
CALL PNOUT ;APPEND SEQ #
MOVE T1,VAL ;RETURN PNTR TO STRING
RET
;ROUTINE TO GET VOLID PNTR INTO T2 (PRESERVES T1)
VOLID2: LOAD T2,TPLBLS ;LABEL BUFFER
ADD T2,[POINT 8,1,31] ;POINT TO VOLID
RET ;RETURN
;RETURN FILE SEQUENCE #
GTFSEQ: LOAD T1,FSEQ ;CURRENT FILE POS
RET
;RETURN VOLUME ID
GTVLID: CALL VOLID2 ;PNTR TO T2
MOVE T1,T2 ;RETURN IN T1
RET
;RETURN POINTER TO USER NAME STRING
GTUSER: HRROI T1,USRNAM+1 ;ACTUAL TEXT BEGINNING
RET
;RETURN FILE GENERATION #
GTFGEN: HRRZ T1,FILVER(JFN) ;FILE GENERATION #
SKIPN T1 ;ANY?
MOVEI T1,1 ;NO - DEFAULT TO 1
RET
;RETURN FILE GENERATION VERSION
GTFGVR: MOVEI T1,0 ;USE 0
RET
;RETURN FILE SECTION NUMBER
GTFSEC: LOAD T1,TPFSEC ;RETURN IN T1
SKIPN T1 ;??
MOVEI T1,1 ;USE 1
RET
;RETURN FILE BYTE SIZE
GTFBSZ: LDB T1,PBYTSZ ;IN FILBYT
RET
;ROUTINE TO SKIP TO CORRECT FILE HEADER AREA
;T1 := # OF FILES TO POSITION
; IF T1 > 0 3*N FILES FORWARD
; IF T1 < 0 3*N+1 FILES BACK , 1 RECORD FORWARD
SKPFIL: STKVAR <COUNT,FUNC>
MOVEI T2,.MOFWF ;ASSUME FORWARD
SKIPGE T1 ;CHECK DIRECTION
MOVEI T2,.MOBKF ;BACKWARDS
MOVEM T2,FUNC ;SAVE FUNCTION
MOVM T2,T1 ;GET MAGNITUDE
IMULI T2,3 ; TIMES 3
SKIPGE T1 ;BACK?
AOS T2 ;YES - ONE MORE
MOVEM T2,COUNT ;SAVE COUNT
SKPFL1: MOVE T2,FUNC ;GET FUNCTION
CALL MTLFCN
RET ;ERROR
CALL CLREOF ;KEEP EOF OFF
SOSLE COUNT ;DECR #
JRST SKPFL1 ;MORE TO DO
MOVE T1,FUNC ;CHECK FUNCTION
CAIE T1,.MOBKF ;BACKWARDS?
RETSKP ;NO - DONE
MOVEI T2,.MOFWR ;YES - FWD 1 RECORD
CALL MTLFCN
RET
CALL CLREOF ;CLEAR EOF
RETSKP ;GOOD RETURN
;ROUTINE TO REPOSITION TO BEGINNING OF A HEADER AREA
REPOS: STKVAR <COUNT>
SETZM COUNT ;INIT TO 0
LOAD T3,TPFLGS ;GET FLAGS
TXNE T3,HDR1 ;HDR1 SEEN
AOS COUNT
TXNE T3,HDR2 ;AND/OR HDR2
AOS COUNT ;COUNT RECORDS
REPOS1: SKIPN COUNT ;ANY MORE TO DO?
RETSKP ;NO - DONE
MOVEI T2,.MOBKR ;BACKUP A RECORD
CALL MTLFCN
RET ;ERROR
SOS COUNT ;DECR COUNT
JRST REPOS1 ;LOOP
;ROUTINE TO READ AND VERIFY HEADER LABELS
HDRCHK: SETZRO <HDR1,HDR2> ;NO VALID HEADERS YET
MOVEI T2,.LBFRD ;READ A LABEL
CALL MTLFCN
JRST HDRERR ;CHECK FOR EOF
HRROI T1,[ASCIZ /HDR1/] ;CHECK FOR THIS
MOVE T2,.H1LID ; IN LABEL ID FIELD
SETO T3, ;USE LABEL BUFFER
CALL LBLCMP ;COMPARE FIELDS
MTERET (IOX69) ;ERROR RETURN
MOVE T2,.H1SEQ ;GET SEQUENCE #
SETO T3, ;FROM LABEL BUFFER
CALL GETLBL ;...
MTERET (IOX69)
JUMPE T1,[MTERET (IOX69)] ;ERROR IF NO SEQUENCE #
STOR T1,FSEQ ;SAVE SEQ POSITION
MOVEI T1,H1LOC ;STORE LABEL IN JSB
CALL STOLBL ;...
SETONE HDR1 ;VALID HDR1 DATA
MOVEI T2,.LBFRD ;SEE IF HDR2 PRESENT
CALL MTLFCN ;...
JRST HDRERR ;CHECK EOF
HRROI T1,[ASCIZ /HDR2/] ;CHECK FOR THIS
MOVEI T2,.H2LID
SETO T3, ;FROM LABEL BUFFER
CALL LBLCMP
JRST HDRBAK ;NOT HDR2 - BACKUP
MOVEI T1,H2LOC ;STORE LABEL
CALL STOLBL
SETONE HDR2 ;SAY WE HAVE HDR2
RETSKP ; AND GIVE GOOD RETURN
HDRERR: TXNN IOS,MT%EOF ;FOUND EOF?
MTERET (IOX69) ;NO - LABEL READ ERROR
CALL CLREOF ;YES - CLEAR IT
HDRBAK: MOVEI T2,.MOBKR ;BACKUP A RECORD
CALL MTLFCN ;...
RET
CALL CLREOF ;CLEAR EOF (IF IT WAS)
JN HDR1,,RSKP ;OK IF HDR1 SEEN
TQNE <READF> ;READING?
MTERET (IOX69) ;YES - ERROR
RETSKP ;ELSE GOOD RETURN (APPEND)
;ROUTINE TO READ AND VERIFY TRAILER LABELS
TLRCHK: SETZRO TPEOF ;CLEAR THIS NOW
LOAD T1,TPUNIT ;GET MTA UNIT #
CALL PHYPOS ;GET CURRENT POSITION INFO
OPSTRM <SUBM T1,>,RCNT ;COMPUTE RECORD COUNT
MOVEI T2,.LBFRD ;READ A RECORD
CALL MTLFCN
JRST TLRER1 ;READ ERROR/TM
HRROI T1,[ASCIZ /EOF1/] ;CHECK FOR THIS FIRST
MOVE T2,.H1LID ;FIELD DESC
SETO T3, ; IN LABEL BUFFER
CALL LBLCMP ;CHECK MATCH
JRST TLREOV ;NOT EOF - CHECK EOV
SETONE TPEOF ;SAY EOF SEEN
TLRCKR: MOVE T2,.H1CNT ;SET TO COMPARE RECORD COUNT
SETO T3,
CALL GETLBL ;FETCH FIELD
MTERET (IOX69) ;NO A VALID NUMBER
OPSTR <SUB T1,>,RCNT ;COMPUTE DIFFERENCE
AOJE T1,TLRCK1 ;JUMPE IF MATCH
SETONE RCCHK ;SET FLAG TO INDICATE NO MATCH
TLRCK1: MOVEI T2,.LBFRD ;READ NEXT RECORD (EOF2/EOV2))
CALL MTLFCN
JRST TLRER2 ;ERROR OR TM
HRROI T1,[ASCIZ /EOF2/] ;CHECK FOR THIS
JN TPEOF,,TLRCK2 ; EOF/EOV?
HRROI T1,[ASCIZ /EOV2/] ;EOV - USE THIS INSTEAD
TLRCK2: MOVE T2,.H2LID
SETO T3, ; IN BUFFER
CALL LBLCMP ;...
JRST TLRBAK ;BACKUP OVER RECORD
RETSKP ;GOOD RETURN
;HERE IF UNABLE TO READ EOF1/EOV1
TLRER1: MTERET (IOX69) ;RETURN ERROR
;HERE IF UNABLE TO READ EOF2/EOV2
TLRER2: TXNN IOS,MT%EOF ;FOUND EOF INSTEAD?
MTERET (IOX69) ;NO - UNABLE TO READ
CALL CLREOF ;YES - CLEAR IT
TLRBAK: MOVEI T2,.MOBKR ;SET TO BACKUP A RECORD
CALL MTLFCN
RET ;PASS ERROR UP
CALL CLREOF ;MAKE SURE EOF IS OFF
RETSKP ;GOOD RETURN
;ROUTINE TO CHECK FOR EOV RECORD
TLREOV: HRROI T1,[ASCIZ /EOV1/] ;CHECK FOR THIS
MOVE T2,.H1LID ;FIELD DESC
SETO T3, ;LABEL BUFFER
CALL LBLCMP ;DO COMPARE
JRST TLRER1 ;ERROR - NO VALID TRAILERS
JRST TLRCKR ;JOIN COMMON CODE (EOF)
;LABEL FIELD UTILITIES
;ROUTINE TO COMPARE A LABEL FIELD WITH VALUE IN T1
;LABEL FIELD DESCRIPTOR IN T2
LBLCMP: ASUBR <VAL,DESC,BFR,PNTR>
CALL MAKEBP ;MAKE A BYTE PNTR
LOAD T4,FLDLEN,DESC ;GET LENGTH IN T4
LOAD T1,FLDTYP,DESC ;GET TYPE
CAIG T1,.FTMAX ;VALID?
JRST @[ CMPSTR ;STRING
CMPNUM ;NUMBER
CMPDAT ;DATE
CMPSPC](T1) ;SPACES
ILLTYP: BUG (HLT,BADTYP,<BAD LABEL FIELD DESC>)
;COMPARE STRING WITH LABEL FIELD
CMPSTR: MOVE T1,VAL ;TEST STRING
TLC T1,-1 ;CHECK FOR -1,,ADDRS
TLCN T1,-1
HRLI T1,(<POINT 7,,>) ;MAKE BP
CMPST1: ILDB T3,T1 ;GET A CHAR
JUMPE T3,CMPSPC ;CHECK FOR REMAINING SPACES
ILDB T2,PNTR ;GET LABEL FIELD CHAR
CAME T2,T3 ;MATCH?
RET ;NO - FAIL RETURN
SOJG T4,CMPST1 ;CONTINUE OVER ALL CHARS
RETSKP ;MATCH - SUCCESS
;COMPARE FIELD FOR SPACES
CMPSPC: ILDB T2,PNTR ;FETCH CHAR (FROM LABEL)
CAIE T2,40 ;SPACE?
RET ;NO - FAIL
SOJG T4,CMPSPC ;CONTINUE
RETSKP ;OK RETURN
;COMPARE NUMBER
CMPNUM: CALL GETNUM ;GET NUMBER FIELD
RET ;ERROR
CAME T1,VAL ;MATCH?
RET ;NO
RETSKP ;YES
;DATE COMPARE
CMPDAT: RET ;NONE
;ROUTINE TO GET LABEL FIELD AND RETURN IT IN T1
GETLBL: ASUBR <VAL,DESC,BFR,PNTR>
CALL MAKEBP ;MAKE A PNTR
LOAD T4,FLDLEN,DESC ;GET FIELD LENGTH
LOAD T1,FLDTYP,DESC ; AND TYPE
CAIG T1,.FTMAX
JRST @[ GETSTR ;STRING
GETNUM ;NUMBER
GETDAT ;DATE
GETSPC](T1) ;SPACES
JRST ILLTYP
GETSPC: RET ;ERROR FOR NOW
GETNUM: SETZ T1, ;INIT NUMBER
GETNM1: ILDB T2,PNTR ;FETCH CHAR
CAIG T2,"9" ;VALID DIGIT?
CAIGE T2,"0"
RET ;NO - RETURN ERROR
IMULI T1,^D10
ADDI T1,-60(T2) ;ACCUM RESULT
SOJG T4,GETNM1
RETSKP ;DONE
;GET STRING R-JUST IN T1
GETSTR: CAILE T4,5 ;MAX OF 5 CHARS
RET ; ELSE ERROR
SETZ T1, ;INIT ANSWER
GETST1: ILDB T2,PNTR ;GET A CHAR
ANDI T2,177 ;MASK TO 7-BITS
LSH T1,7 ;MAKE SPACE
IOR T1,T2 ;PLUNK CHAR DOWN
SOJG T4,GETST1 ;LOOP TILL DONE
RETSKP ;GOOD RETURN
;GET A JULIAN DATE
GETDAT: ILDB T1,PNTR ;FIRST CHAR
CAIE T1,40 ;BETTER BE A SPACE
RET
MOVEI T4,2 ;GET YEAR DIGITS
CALL GETNUM
RET ;ERROR
PUSH P,T1 ;SAVE YEAR
MOVEI T4,3 ;GET DAY DIGITS
CALL GETNUM
JRST [ ADJSP P,-1 ;ERROR , CLEAN OFF PDL
RET]
POP P,T2 ;RETRIEVE YEAR
ADDI T2,^D1900 ;MAKE INTO REAL YEAR
HLRZS T2 ;MOVE TO LHS
HRR T2,T1 ;DAY NUMBER TO RHS
MOVX T4,IC%JUD ;CONVERT JULIAN
IDCNV ;
RETBAD () ;INTERNAL ERROR
HLRZ T1,T2 ;COPY DATE TO T1 (DISCARD TIME)
RETSKP ;GOOD RETURN
;ROUTINE TO MAKE A BYTE POINTER TO A LABEL FIELD
;ASSUMES GLOBAL VARS:
; DESC - LABEL FIELD DESCRIPTOR
; BFR - BUFFER ADDRS (OFFSET FROM TPLBLS, OR -1)
; PNTR - RETURN RESULT
MAKEBP: MOVE T1,BFR ;GET BUFFER LOC
JUMPGE T1,[LOAD T2,TPLBLS ;GET LABEL STORAGE PNTR
ADD T2,T1 ;ADD IN OFFSET
JRST MAKBP1]
HRRZ T2,U ;GET UNIT #
IMULI T2,.LBLEN ; TIMES BUFFER LENGTH
ADDI T2,TLABBF ; PLUS BASE ADDRS
MAKBP1: MOVEM T2,BFR ;SAVE BUFFER ADDRS
SETZ T2, ;INIT INDEX
LOAD T1,FLDPOS,DESC ;GET CHAR POS
SUBI T1,2 ;OFFSET BY 2
ASHC T1,-2 ; / 4
ROT T2,3 ;GET REMAINDER * 2
TRZ T2,4 ; MOD 4
ADD T1,[POINT 8,0,7
POINT 8,0,15
POINT 8,0,23
POINT 8,0,31](T2) ;ADD IN CORRECT POINTER
ADD T1,BFR ;BUFFER START ADDRS
MOVEM T1,PNTR ;SAVE RESULT
RET ;RETURN
;ROUTINE TO SAVE LABEL IN LABEL AREA
;C(T1) := LABEL OFFSET INTO LABEL AREA
STOLBL: HRRZ T2,U ;GET UNIT #
IMULI T2,.LBLEN ; TIMES LENGTH
ADDI T2,TLABBF ; PLUS BUFFER START
OPSTR <ADD T1,>,TPLBLS ;COMPUTE LABEL LOC
HRLZS T2 ; FROM ,, 0
HRR T2,T1 ; FROM ,, TO
BLT T2,.LBLEN-1(T1) ;MOVE LABEL
RET
;ROUTINE TO COPY LABEL INTO BUFFER
;C(T1) := LABEL OFFSET INTO LABEL AREA
FETLBL: HRRZ T2,U ;UNIT #
IMULI T2,.LBLEN
ADDI T2,TLABBF ;BUFFER ADDRS
OPSTR <ADD T1,>,TPLBLS
HRL T2,T1 ; FROM ,, TO
HRRZ T1,T2 ; DESTINATION
BLT T2,.LBLEN(T1) ;MOVE IT
RET
;CLOSE PROCESSING
CLOSE: LOAD T1,TPSTAT ;CHECK STATE
TQNN <WRTF> ;CHECK OUTPUT/INPUT
JRST @CIDIS.(T1) ;DISPATCH INPUT CLOSE
JRST @CODIS.(T1) ;DISPATCH OUTPUT CLOSE
;CLOSE STATE DISPATCH TABLE
CIDIS.: STDIS (CI) ;GEN TABLE INPUT
CODIS.: STDIS (CO) ;GEN TABLE OUTPUT
CO.CLS:
CI.CLS: RETSKP ;ALREADY CLOSED - RETURN
;TAPE IN DATA AREA - CHANGE THAT
CO.RDY: SKIPA T2,[.MOEOF] ;WRITE TAPE MARK
CI.RDY: MOVEI T2,.MOFWF ;SKIP TO TM
CALL MTLFCN ;...
RET ;BLOCK
CALL CLREOF ;CLEAR EOF INDICATION
MOVEI T1,.STEOF ;PREPARE FOR TRAILERS
STOR T1,TPSTAT
JRST CLOSE ;CONTINUE PROCESSING
CI.EOF: MOVEI T2,.MOFWF ;NOW SKIP TO END OF LABELS
CALL MTLFCN
RET
MOVEI T1,.STUTL ;MOVE TO LAST STATE
STOR T1,TPSTAT ;...
JRST CLOSE ;CONTINUE
;TAPE READY FOR TRAILERS
CO.EOF:
CO.ETL: HRROI T1,[ASCIZ "EOF1"] ;WANT EOF LABELS
HRROI T2,[ASCIZ "EOF2"]
CALL WRTTLR ;WRITE TRAILERS
RET ;PASS BLOCK UP
SETZRO <HDR1,HDR2> ;NO HEADERS
INCR FSEQ ;STEP TO NEXT FILE
INCR USRSEQ ;...
MOVEI T1,.STUTL ;MOVE TO FINAL STATE
STOR T1,TPSTAT ;...
JRST CLOSE ;AND WRAPUP
CI.UTL:
CO.UTL: MOVEI T1,0 ;NO ABORT
MOVE T3,SAV3 ;BLOCK ROUTINE ADDRS
UCALL MTACLZ ;PERFORM ACTUAL CLOSE OPR.
RET ;BLOCK / ERROR
LOAD T2,TPLBLS ;RETURN FREE BLOCK
MOVEI T1,JSBFRE ; THAT HELD LABELS
CALL RELFRE ;...
SETZRO TPLBLS ;CLEAR POINTER
MOVEI T1,.STCLS ;SAY WE ARE NOW CLOSED
STOR T1,TPSTAT ;...
JRST CLOSE ;AND EXIT
;TAPE STILL IN HEADER AREA
CO.UHL: SKIPA T2,[.MOEOF] ;WRITE A TAPE MARK
CI.UHL: MOVEI T2,.MOFWF ;SKIP TO TAPE MARK
CALL MTLFCN ;...
RET ;RETURN ERROR
CALL CLREOF ;CLEAR EOF/EOT
MOVEI T1,.STRDY ;WE ARE NOW READY?
STOR T1,TPSTAT
JRST CLOSE ;MORE TO COME
;ROUTINE TO WRITE TAPE TRAILERS (EOF/EOV)
;LABEL ID INFO IN T1,T2
WRTTLR: STKVAR <HD1,HD2>
MOVEM T1,HD1 ;SAVE T1,T2
MOVEM T2,HD2
MOVEI T1,H1LOC ;GET HDR1 LABEL
CALL FETLBL
MOVE T1,HD1 ;NEW ID
MOVE T2,.H1LID ;DESCRIPTOR
SETO T3, ;USE BUFFER
CALL SETLBL ;COPY ID TO LABEL
MTERET (IOX69)
LOAD T1,TPUNIT ;GET UNIT #
CALL PHYPOS ;GET POSITION INFO
OPSTR <SUB T1,>,RCNT ;COMPUTE DIFFERENCE
SUBI T1,1 ;** FUDGE **
MOVE T2,.H1CNT ;SET BLOCK COUNT FIELD
SETO T3,
CALL SETLBL ;...
MTERET (IOX69)
MOVEI T2,.LBFWR ;SET TO WRITE
CALL MTLFCN
RET ;PASS ERROR UP
CALL CLREOF ;NO EOT
MOVEI T1,H2LOC ;FETCH HDR2
CALL FETLBL
MOVE T1,HD2 ;NEW HEADER
MOVE T2,.H2LID ;DESC
SETO T3, ; INTO BUFFER
CALL SETLBL ;...
MTERET (IOX69)
MOVEI T2,.LBFWR ;WRITE IT
CALL MTLFCN
RET ;ERROR
CALL CLREOF ;NO EOT
RETSKP ;OK RETURN
;LABEL READ/WRITE ROUTINES
LBLWRT: CALL SETSTS ;SAVE WORLD
TQO <WRTF> ;GRNTEE WRITE PRIVS
HRRZ T1,U ;UNIT #
IMULI T1,.LBLEN ;LENGTH OF BUFFER
ADD T1,[-.LBLEN,,TLABBF-1] ;MAKE IOWD
UCALL MTDMOX ;WRITE RECORD
JRST CKLERR ;CHECK ERROR
CALL RETSTS ;RESTORE STATUS
RETSKP ;GOOD RETURN
LBLRED: CALL SETSTS ;SAVE WORLD
TQO <READF> ;GRNTEE READ PRIVS
HRRZ T1,U ;UNIT #
IMULI T1,.LBLEN ;TIMES SIZE
ADD T1,[-.LBLEN,,TLABBF-1] ;MAKE IOWD
UCALL MTDMIX ;READ RECORD
JRST CKLERR ;CHECK ERROR
CALL RETSTS ;RESTORE STATUS
RETSKP ;GOOD RETURN
SETERR: TQO <ERRF> ;SET ERROR
MOVEI T1,OPNX8 ;ERROR CODE TO RETURN
;HANDLE GENERAL CASE
CKLERR: TQNN <ERRF,EOFF> ;WAS ERROR COMMITTED
RET ;NO - JUST PASS ON UP (BLOCK)
PUSH P,T1 ;SAVE ERROR CODE
CALL RETSTS ;RESTORE STS, ETC...
TXNE IOS,MT%EOT!MT%EOF ;CHECK EOT/EOF
JRST [ POP P,T1 ;YES - RESTORE CODE
RET] ; AND GIVE ERROR RETURN
; PRESERVING VV
;*** REAL ERROR ***
SETZRO TPVV ;CLEAR VOLUME VALID
MOVEI T1,.PRERR ;LABEL R/W ERROR
CALL PLRMSG
MOVX T1,CZ%ABT ;CLOSE AND ABORT
UCALL MTACLZ
BUG (CHK,CKLBLK,<CKLERR: CLOSE AND ABORT BLOCKED>)
LOAD T2,TPLBLS ;RETURN LABEL BLOCK
MOVEI T1,JSBFRE ; IN JSB
CALL RELFRE
SETZRO TPLBLS ;CLEAR PNTR
MOVEI T1,.STCLS ;SET STATE TO CLOSED
STOR T1,TPSTAT
SETZRO TPLPCS ;NO FUNCTION IN PROGRESS
POP P,T1 ;RESTORE CODE
RET ;RETURN ERROR
;ROUTINE TO SETUP STATUS INFO FOR LABEL READ/WRITE
SETSTS: OPSTR <SKIPE>,FSSAV ;SAVED ALREADY?
RET ;YES - JUST RETURN
STOR STS,FSSAV ;NO - STORE FILSTS
LOAD T3,TPUNIT ;GET MTA UNIT #
LOAD T1,MTRS,(T3) ;GET RECORD SIZE
STOR T1,TPMTRS ;SAVE IT
MOVEI T1,.LBRSZ ;LABEL RECORD SIZE
STOR T1,MTRS,(T3)
LOAD T1,MTDM,(T3) ;DATA MODE
STOR T1,TPMTDM
MOVEI T1,.LBTDM ;LABEL DATA MODE
STOR T1,MTDM,(T3)
LOAD T1,MTHBW,(T3) ;HARDWARE BYTES/WD
STOR T1,TPMHBW
MOVEI T1,.LBHBW ;LABEL BYTES/WD
STOR T1,MTHBW,(T3)
STOR IOS,SVIOS ;SAVE IOS
MOVX IOS,OPND ;SET DUMP MODE
IORB IOS,MTASTS(T3) ;...
RET ;RETURN
;ROUTINE TO RESTORE MTA STATUS
RETSTS: OPSTR <SKIPN>,FSSAV ;ANYTHING SAVED?
RET ;NO - JUST RETURN
ANDX STS,ERRF!EOFF ;PRESERVE THESE STATUS BITS
OPSTR <IOR STS,>,FSSAV ;...
MOVEM STS,FILSTS(JFN)
SETZRO FSSAV ;MARK RESTORED
LOAD T3,TPUNIT ;GET MTA UNIT #
LOAD T1,TPMTRS ;RESTORE RECORD SIZE
STOR T1,MTRS,(T3)
LOAD T1,TPMTDM ;RESTORE DATA MODE
STOR T1,MTDM,(T3)
LOAD T1,TPMHBW ;RESTORE BYTES/WD
STOR T1,MTHBW,(T3)
ANDX IOS,MT%EOF!MT%EOT ;PRESERVE THESE
OPSTR <IOR IOS,>,SVIOS ; IN MTASTS
MOVEM IOS,MTASTS(T3) ;...
RET ;RETURN
;MTOPR SUPPORT FOR USER LABEL I/O
MTULR::
MTULW:: RETBAD (IOX69)
MTTLS::
MTTLG:: RETBAD (IOX69)
;SUPPORT ROUTINES FOR .MOATU
;ROUTINE TO SETUP U FOR MT UNIT #
;RETURNS T1 := MTA UNIT #
; T2 := CURRENT CONTENTS OF TPUNIT
MSETU: XCTU [HLRZ T1,3] ;GET MT UNIT #
CAIL T1,MTAN ;CHECK MAX VALUE
RETBAD (ARGX19) ;BAD ARGUMENT
EXCH T1,U ;SET U TO MT UNIT
LOAD T2,TPUNIT ;RETURN CURRENT MTA UNIT
RETSKP
;ROUTINE TO SET MTA UNIT NUMBER INTO MT DATA BASE.
SETMTU::CALL MSETU ;SETUP U , ETC.
RETBAD () ;BAD ARGUMENT
STOR T1,TPUNIT ;STORE MTA UNIT #
JRST SETVVX ;EXIT AND RESTORE U
;ROUTINE TO SET VOLUME VALID FOR MT UNIT
SETVV:: CALL MSETU ;SETUP U ETC.
RETBAD ()
CAME T2,T1 ;BETTER BE THE SAVE
JRST MTUX1 ;BAD UNIT NUMBER
SETONE TPVV ;TURN ON VV
SETZRO FSEQ ;CLEAR KNOWN POSITION
SETZRO <HDR1,HDR2>
SETVVX: LOAD U,TPUNIT ;RESTORE U
RETSKP ;SKIP RETURN
;ROUTINE TO CLEAR VV
CLRVV:: CALL MSETU ;SETUP U
RETBAD () ;ERROR
CAME T1,T2 ;THIS ONE OK
JRST MTUX1 ;NO - INVALID UNIT #
SETZRO TPVV ;CLEAR VOLUME VALID
JRST SETVVX ;RESTORE U
;ROUTINE TO CLEAR UNIT #
CLRMTU::CALL MSETU ;SETUP U
RETBAD () ;ERROR
SETONE TPUNIT ;SET UNIT TO -1
MOVE U,T1 ;RESET UNIT #
RETSKP
MTUX1: LOAD U,TPUNIT ;RESTORE U
RETBAD (ARGX19) ;ILLEGAL ARG RETURN
;GET/PUT VOLUME LABELS FROM PULSAR
PUTVOL::CALL MSETU ;GET MT UNIT #
RETBAD () ;ERROR
CAME T2,T1 ;UNITS MATCH?
JRST MTUX1 ;NO - ARG ERROR
LOAD T3,TPLBLS ;HAVE LABEL SPACE?
JUMPN T3,PUTVL1 ;YES - DON'T ALLOCATE
MOVEI T2,4*.LBLEN+1 ;NO - ALLOCATE JSB SPACE
CALL ASGJFR
RETBAD ()
STOR T1,TPLBLS ;SAVE ADDRS
MOVE T3,T1 ;PUT IN PLACE FOR BLT
PUTVL1: ADDI T3,V1LOC ;OFFSET FOR VOL1
UMOVE T2,4 ;GET USER PNTR
MOVEI T1,2*.LBLEN ;RECORD SIZE FOR VOL1 & UVLD
CALL BLTUM ;MOVE TO MONITOR
SETZRO UVLD ;ASSUME NO UVLD
HRROI T1,[ASCIZ "UVLD"] ;STRING TO MATCH
MOVE T2,.UVLID ;CHECK UVLD ID
MOVEI T3,UVLOC ;BUFFER OFFSET
CALL LBLCMP ;COMPARE
JRST PUTVL2 ;NO MATCH - NONE
SETONE UVLD ;HAVE VALID UVLD LABEL
PUTVL2:
;**** FLAGS FROM PULSAR ****
JRST SETVVX ;RESTORE U AND EXIT
GETVOL::CALL MSETU ;SETUP U
RETBAD ()
CAME T1,T2 ;CORRECT MT UNIT?
JRST MTUX1 ;NO - ERROR
LOAD T2,TPLBLS ;LABEL BUFFER ADDRS
JUMPE T2,[LOAD U,TPUNIT ;ERROR IF NONE
RETBAD (IOX69)]
ADDI T2,V1LOC ;OFFSET
UMOVE T3,4 ;POINTER TO USER BUFFER
MOVEI T1,2*.LBLEN ;MOVE VOL1 & UVLD
CALL BLTMU ;...
;*** FLAGS ***
JRST SETVVX ;RESTORE U AND EXIT
;PULSAR INTERFACE
;ROUTINE TO SEND STANDARD MESSAGE TO PULSAR
;C(T1) := CODE
PLRMSG: RET ;*** TEMP ***
;ROUTINE TO JACKET CALLS TO MAGTAP AND PRESERVE U & DEV.
SAVEU: AOS CX ;INCR OVER ROUTINE ADDRS
PUSH P,CX ;SAVE RETURN ADDRS
PUSH P,U ;SAVE U
LOAD U,TPUNIT ;SETUP MTA UNIT
HRL DEV,U ;...
CALL @-1(CX) ;CALL ACTUAL ROUTINE
URET: SOS -1(P) ;HANDLE NON-SKIP
AOS -1(P) ; AND SKIPS
MOVE IOS,MTASTS(U) ;GET FRESH STATUS
POP P,U ;RESTORE U
HRL DEV,U ;RESTORE DEV TO MT UNIT
RET ;RETURN
TNXEND
END