TITLE 'DOS-11 tape reader' *++ * * -*-ASMH-*- * * Program to read DOS-11 magtapes on MTS. * * JMBW Nov 24/90 Created. * *-- T EQU 0 ;AC def's A EQU 1 B EQU 2 C EQU 3 D EQU 4 E EQU 5 F EQU 6 G EQU 7 RC EQU 15 ;return code from JSYS's * MACRO &LAB JSYS &DEST,&ARGS,&ERR ;Jump to SYStem &LAB L 15,=V(&DEST) AIF ('&ARGS' EQ '').NOARGS LA 1,&ARGS .NOARGS BASR 14,15 AIF ('&ERR' EQ '').NOERR LTR RC,RC BNZ &ERR .NOERR MEND * DOS11 CSECT ENTER 12,SA=REGS * see if term is a Courier (no square brackets) JSYS GETFD,=C'*MSINK* ' ;SPRINT might be redirected ST T,DUMMY ;save JSYS CONTROL,=A(SNSBUF,SNSLEN,DUMMY,0) ;sense *MSINK* L T,DUMMY ;get FDUB ptr back JSYS FREEFD ;lose it CLC SNSDVTYP(3),=C'327' ;Courier or 327X? BNE NOTEBC ;no, leave brackets alone MVC BRACK(2),=C'()' ;change to parens * NOTEBC JSYS GETFD,=C'*MT* ' ;get FDUB ptr ST T,TAPEFD ;save *+ * * Command loop. * *- LOOP JSYS SETPFX,=A(PROMPT) ;set prefix MVC CMD(80),=CL80' ' ;blank out command line JSYS GUSER,=A(CMD,LEN,@UC,DUMMY),STOP ;read a line JSYS SETPFX,=A(BLANK) ;blank prefix CLI CMD,C'D' ;directory? BE DIR CLI CMD,C'G' ;get tape file? BE GET CLI CMD,C'R' ;rewind tape? BE REW B LOOP ;loop STOP JSYS FREEFD,=A(ATPFD) ;release tape JSYS EXIT *+ * * Display tape directory. * *- DIR JSYS READ,=A(BUF,LEN,ZERO,DUMMY,TAPEFD),LOOP ;get label * display directory record BAL F,DIRNAM ;get name from dir. ent MVC LINE+25(15),=C'< X> 0X-XXX-0' ;set up field XR A,A ;prot. code IC A,BUF+8 LA C,LINE+29 BAL E,DEC * date is (year-1970.)*1000.+(day within year) XR G,G ;date IC G,BUF+10 ICM G,2,BUF+11 XR F,F D F,=F'1000' ;remove year (leave day in F) AH G,=H'70' ;+1970. LR C,G ;copy XR B,B D B,=F'100' ;make sure we pass 2000. OK LR A,B ;get rem (=year within century) MVI DAYS+1,X'1C' ;(28) assume not leap year N B,=F'3' ;check low 2 bits BNZ NOLEAP ;nope MVI DAYS+1,X'1D' ;(29) leap year NOLEAP LA C,LINE+41 BAL E,DEC LA A,MONTHS ;pt at months LA B,DAYS ;no. of days in each MONLP XR T,T ;get # days in this month IC T,0(B) CLR F,T ;is this the right month? BLE GOTMON ;yes, skip SR F,T ;no, subtract it LA A,3(A) ;advance ptrs LA B,1(B) B MONLP ;loop GOTMON MVC LINE+35(3),0(A) ;copy month name LR A,F ;get day within month LA C,LINE+34 BAL E,DEC ;write it * display the whole mess on SPRINT MVC LEN,=H'41' ;length JSYS SPRINT,=A(LINE,LEN,ZERO,DUMMY) ;print it * skip the data records XR C,C ;init count SKPDAT JSYS READ,=A(BUF,LEN,ZERO,DUMMY,TAPEFD),SKPDON ;read XR A,A ;zap ICM A,3,LEN ;get length of this one AR C,A ;add to total B SKPDAT ;loop SKPDON MVC LINE(17),=C' bytes' LR A,C ;get byte count LA C,LINE+11 BAL E,DEC MVC LEN,=H'17' ;length JSYS SPRINT,=A(LINE,LEN,ZERO,DUMMY) B DIR *+ * * Get a tape file. * *- GET JSYS READ,=A(BUF,LEN,ZERO,DUMMY,TAPEFD),FNF ;get label BAL F,DIRNAM ;get name * see if this is it CLC LINE(25),CMD+2 ;is this the file? BE RFILE ;yes, go read it * no, skip data GET5 JSYS READ,=A(BUF,LEN,ZERO,DUMMY,TAPEFD) LTR RC,RC ;tape mark? BZ GET5 ;no, skip B GET ;try next dir entry FNF JSYS SERCOM,=A(NOSUCH,LNOSUC,ZERO,DUMMY) B LOOP ;loop * got it - actually read the file RFILE JSYS SETPFX,=A(QUES) ;set prompt MVC CMD(80),=CL80' ' ;blank out filename JSYS GUSER,=A(CMD,LEN,ZERO,DUMMY) JSYS SETPFX,=A(BLANK) ;back to blank JSYS GETFD,CMD ;get FDUB ptr ST T,FILEFD ;save it XR C,C ;init count RFILE1 JSYS READ,=A(BUF,LEN,ZERO,DUMMY,TAPEFD),RFILE2 ;get rec XR A,A ;get length ICM A,3,LEN AR C,A ;add it in JSYS WRITE,=A(BUF,LEN,ZERO,DUMMY,FILEFD) ;write a rec B RFILE1 ;loop RFILE2 JSYS FREEFD,=A(AFLFD) ;close the file MVC LINE(29),=C' bytes transferred' LR A,C ;get count LA C,LINE+11 BAL E,DEC MVC LEN,=H'29' ;set length JSYS SPRINT,=A(LINE,LEN,ZERO,DUMMY) B LOOP ;back to loop *+ * * Rewind the tape. * *- REW L T,TAPEFD ;get FDUB ptr XR A,A ;differentiate from name JSYS REWIND# ;rewind the tape B LOOP *+ * * Convert directory entry in BUF into * bFILENAME.EXT[p,pn] at LINE. * *- DIRNAM LA D,LINE ;pt at line buf MVC 0(25,D),=CL25' ' ;zap out filename LA D,1(D) ;skip carriage control IC A,BUF ;fn1-3 ICM A,2,BUF+1 BAL E,RAD50 IC A,BUF+2 ;fn4-6 ICM A,2,BUF+3 BAL E,RAD50 IC A,BUF+12 ;fn7-9 ICM A,2,BUF+13 BAL E,RAD50 MVI 0(D),C'.' ;extension LA D,1(D) IC A,BUF+4 ;ex1-3 ICM A,2,BUF+5 BAL E,RAD50 IC T,BRACK ;[ STC T,0(D) XR A,A ;proj IC A,BUF+7 LA C,4(D) BAL E,DEC MVI 4(D),C',' ;, XR A,A ;prog IC A,BUF+6 LA C,8(D) BAL E,DEC MVC 8(1,D),BRACK+1 ;] * remove blanks LA A,LINE ;pt at line LA B,25 ;length LR C,A ;output ptr LR D,B ;output len RMBL1 CLI 0(A),C' ' ;blank? BE RMBL2 ;yes, skip MVC 0(1,C),0(A) ;copy char LA C,1(C) ;bump output ptr BCTR D,0 ;count the char RMBL2 LA A,1(A) ;bump ptr BCT B,RMBL1 ;loop RMBL3 MVI 0(C),C' ' ;blank out rest of field LA C,1(C) BCT D,RMBL3 BR F *+ * * Convert a radix-50 word to EBCDICK. * * Enter with word in A. * Save 3 characters at D (update ptr). * *- RAD50 N A,=F'65535' ;isolate low halfword XR T,T ;sign-extend D T,=F'40' ;/octal 50 LR C,T ;get remainder (3rd char) XR T,T ;sign-extend D T,=F'40' ;/octal 50 LR B,T ;copy rem to non-zero AC IC T,R50(A) ;first chr STC T,0(D) IC T,R50(B) ;2nd STC T,1(D) IC T,R50(C) ;3rd STC T,2(D) LA D,3(D) ;bump ptr BR E *+ * * Convert a number in A. * Write it backwards at C. * *- DEC XR T,T ;sign-extend D T,=F'10' ;/10 BCTR C,0 ;-1 STC T,0(C) ;save OI 0(C),C'0' ;convert LTR A,A ;anything left? BNZ DEC ;loop if so BR E * pure data LTORG ;lits first SNSLEN DC H'56' ;length of SNS buffer ZERO DC F'0' ;modifier @UC DC XL4'00000020' ;@UC R50 DC C' ABCDEFGHIJKLMNOPQRSTUVWXYZ$.%0123456789' MONTHS DC C'JanFebMarAprMayJunJulAugSepOctNovDec' ATPFD DC A(TAPEFD) ;ptr to TAPEFD AFLFD DC A(FILEFD) ;ptr to FILEFD PROMPT DC C'>' QUES DC C'?' BLANK DC C' ' LNOSUC DC Y(L'NOSUCH) NOSUCH DC C' ?Can''t find file or account' * initialized data DAYS DC AL1(31,28,31,30,31,30,31,31,30,31,30,31) ;patch Feb BRACK DC C'[]' ;change to () on EBCDICK term * SENSE *MSINK* to see if it's an EBCDICK terminal SNSBUF DC C'SNS' ;sense *MSINK* SNSMDSET DS X ;=0 for terminals SNSDVNAM DS CL4 ;device name ('N001', &c.) SNSDVTYP DS CL4 ;device type ('VTP ', &c.) SNSCUNAM DS CL4 ;ctrl unit name ('NET0', &c.) SNSCUTYP DS CL4 ;ctrl unit type SNSLAID DS CL4 ;line adapter ID ('DIAL', &c.) SNSTRNAM DS CL24 ;terminal name (yeah right) SNSTRTYP DS CL8 ;term type (Vol. IV) * pure storage LEN DS H ;I/O length halfword LINE DS 41C ;directory output line CMD DS 80C ;command line * DUMMY DS F ;line #'s returned here TAPEFD DS F ;tape FDUB ptr FILEFD DS F ;file FDUB ptr REGS DS 18F ;R13 save area BUF DS 32767C ;input buffer * END DOS11