;-*- Mode:MIDAS; Fonts: MEDFNT -*- TITLE PRINT - Print long-named file (yeeech) ;;; We take a fully spec'd long filename as JCL, open the file in UAI ;;; mode, and print it out on the terminal. ^S works to flush it. ;;; Use ^Q to quote commas, nuls, linefeeds, etc., in a filename. ;;; If XJNAME is ^F or LISTF, we append ;.FILE. (DIR) to the filename. ;;; This kludge should be fixed to use DIR: device if possible. ;;; If XJNAME is $^R or COPY we take sourcefile, destfile as JCL. ;;; Maybe there should be a switch specifying to first copy into ;;; _COPY_ OUTPUT and then rename instead of copying directly? ;;; It'll take lots of hacking to make ITS *really* support long filenames! PG$SIZ==2000 Z=0 ;Super temp A=1 ;A-E general purpose, B=2 ; always preserved C=3 D=4 E=5 CH=6 ;Character being hacked. T=10 ;Temps TT=T+1 P=17 ;Stack pointer FOOO=13 ;Device output. FOOI=14 ;Device input. TTYO=15 ;Console typeout TTYI=16 ;Console typein DEFINE SYSCAL A,B .CALL [SETZ ? SIXBIT/A/ ? B ((SETZ))] TERMIN CALL==: RET==: CALRET==:JRST NOP==: DEFINE TMPLOC VAL,?ARG %%%TLC==. LOC VAL ARG LOC %%%TLC TERMIN DEFINE NORM7 AC SKIPGE AC SUB AC,[430000,,1] TERMIN DEFINE DECBP AC ADD AC,[70000,,] SKIPGE AC SUB AC,[430000,,1] TERMIN DEFINE TYPE CH,&STRING CALL [ MOVEI T,<.LENGTH STRING> MOVE TT,[440700,,[ASCII STRING]] SYSCAL SIOT,[%CLIMM,,CH ? TT ? T] .LOSE %LSFIL RET ] TERMIN ;;; Various returns. INTRET: SYSCAL DISMIS,[%CLBIT,,INTACS ? P] .LOSE %LSSYS POPJ1: AOS (P) ;Skip CPOPJ: RET ;Return DEATH: SKIPE DEBUG .VALUE .LOGOUT 1, ;;; Interrupt vector. TMPLOC 42,{-LTSINT,,TSINT} ;New style interrupt handler. INTACS==2+T_6 ;Protect T,TT for handlers. TSINT: INTACS,,P 0 ? 1_TTYI ? 0 ? <1_TTYO>\<1_TTYI> ? INTCHR 0 ? 1_TTYO ? 0 ? 0 ? INTMOR LTSINT==:.-TSINT ;;; INTCHR - Handler for console input interrupts. INTCHR: MOVEI T,TTYI ;Get interrupt character in T. .ITYIC T, JRST INTRET CAIN T,^G ;^G flushes anything, even copy JRST INTC10 skipn copyp ;^S should not flush copying CAIE T,^S JRST INTRET INTC10: .RESET TTYO, ;^G and ^S should echo on flushing. Do they? SYSCAL TTYFLS,[ %CLBIT,,1 ? %CLIMM,,TTYI] .LOSE %LSSYS .value [asciz/:!kill :î/] ;type ! jrst death ;try again, just in case ;;; INTMOR - Handler for **MORE** condition. INTMOR: TYPE TTYO,"--More--" SYSCAL IOT,[%CLBIT,,%TIPEK ? %CLIMM,,TTYI ? %CLOUT,,T] .LOSE %LSFIL CAIE T,40 CAIN T,177 .IOT TTYI,T CAIN T,40 JRST [ TYPE TTYO,"A" JRST INTRET ] type ttyo,"Flushed " .value [asciz/:kill /] ;type Flushed, leave cursor there. .BREAK 16,64000 ;try again, supposedly silent JRST DEATH ;what, still alive after all that??? SUBTTL Main program GO: MOVE P,[-PDLLEN,,PDL-1] SYSCAL OPEN,[%CLBIT,,<.UAO\%TJDIS> ? %CLIMM,,TTYO ? [SIXBIT /TTY/]] .LOSE %LSFIL SYSCAL OPEN,[%CLBIT,,.UAI ? %CLIMM,,TTYI ? [SIXBIT /TTY/]] .LOSE %LSFIL ;; Set up TTY interrupts like DDT has. SYSCAL TTYSET,[%CLIMM,,TTYI ? [222222,,222222] ? [230222,,220222]] aos ttinit ;not really a TTY, don't clear screen MOVE A,[-8.,,[ .ROPTION ? TLO %OPINT\%OPOPC .RMSK2 ? IOR [<1_TTYI>\<1_TTYO>] .ROPTION ? MOVEM B .RXJNAME ? MOVEM C]] SYSCAL USRVAR,[ %CLIMM,,%JSELF ? A ] ;temp keep XJNAME in C. .LOSE %LSSYS setz tt came c,[sixbit/COPY/] ;COPY command camn c,[sixbit/$^R/] aos tt ;wants a comma movem tt,copyp TLNN B,%OPCMD ;Require JCL. JRST [ TYPE TTYO,"A Usage is :PT long filename to print :PF long directory to list :CY source, destination" JRST DEATH ] .CORE BUFPAG+1 ;Get buffer page. JRST [ TYPE TTYO,"ACan't get core." JRST DEATH ] .BREAK 12,[..RJCL,,JCLBUF] ;Gobble JCL. MOVE A,[440700,,JCLBUF] MOVE B,[440700,,FNAME] ;Read filename from JCL. movei ch,40 JCLGET: ILDB T,A cain t,", jrst [ skipe copyp ;if not copy skipe comma ;or too many commas .lose %lssys+%ebdfn ;bad filename movem b,comma move b,[440700,,CNAME] jrst jclget] CAIE T,0 CAIN T,33 JRST jclend CAIE T,^_ CAIN T,^C JRST jclend CAIE T,^J CAIN T,^M JRST jclend IDPB T,B caie t,": cain t,"; movem b,devdir caie t,40 movem b,nonbl caie t,^Q jrst jclget ildb t,a idpb t,b movem b,nonbl JRST JCLGET jclend: came c,[sixbit/LISTF/] ;LISTF kludge camn c,[sixbit/^F/] skipa jrst jclopn move a,[440700,,[asciz/;.file. (dir)/]] move b,nonbl ldb t,b cain t,"; came b,devdir skipa ibp a ;already have an unquoted semicolon, don't append one jcldir: ildb t,a idpb t,b jumpn t,jcldir jclopn: MOVE A,[440700,,FNAME] ;Open up the file. SYSCAL SOPEN,[%CLBIT,,.UAI ? %CLERR,,B ? %CLIMM,,FOOI ? a ] JRST OPNERR movei e,ttyo ;channel to output to skipe copyp jrst [movei e,fooo move a,[440700,,cname] ;later use _COPY_ OUTPUT with RNFL. syscal sopen,[%clbit,,.uao ? %clerr,,b ? e ? a ] jrst opnerr jrst .+1] LOOP: MOVE B,[440700,,BUFFER] ;Bp to buffer. MOVEI D,BUFLEN*5 ;Chars buffer can hold. MOVE C,D ;Ask for full buffer. SYSCAL SIOT,[%CLIMM,,FOOI ? B ? C ] .LOSE %LSFIL SUB D,C ;D gets chars in buffer. skipe copyp jrst copy MOVE T,B ;Get Bp to end of buffer. NORM7 T trim: LDB CH,T ;Get the possibly offensive character. cain CH,^C ;If this is the magic EOF character JRST [ DECBP T ; back up the bp SOJN D,trim ; and decrement real length. TYPE TTYO,"ANo data!" JRST DEATH ] aosn ttinit ;Once only TYPE TTYO,"C" ;clear the screen. copy: MOVE B,[440700,,BUFFER] MOVE C,D SYSCAL SIOT,[ E ? B ? C ] .LOSE %LSFIL CAIL D,BUFLEN ;If we received a full buffer of data JRST LOOP ; go back and see if there is more. skipn copyp ;Else reached EOF - wrap up. JRST DEATH syscal close,[ e ] ;RENMWO eventually .lose %lsfil .value [asciz/:kill :î/] ;type jrst death ;in case ddt missed OPNERR: TYPE TTYO,"A" OPNER1: ILDB T,A CAIE T,0 CAIN T,33 JRST OPNER2 CAIE T,^_ CAIN T,^C JRST OPNER2 CAIE T,^J CAIN T,^M JRST OPNER2 .IOT TTYO,T JRST OPNER1 OPNER2: SYSCAL OPEN,[%CLIMM,,FOOI ? [SIXBIT/ERR/] ? [4] ? B] JRST DEATH TYPE TTYO," - " OPNER3: .IOT FOOI,T CAIN T,^M JRST OPNER4 CAIE T,^L CAIN T,^C JRST OPNER4 JUMPL T,OPNER4 .IOT TTYO,T JRST OPNER3 OPNER4: JRST DEATH DEBUG: 0 PDLLEN==512. PDL: BLOCK PDLLEN ;The Stack. PATCH: BLOCK 40 ttinit: -1 copyp: 0 ;1 Iff COPY instead of PRINT comma: 0 ;BP to last , in JCL devdir: 0 ;BP to last unquoted : or ; in FNAME nonbl: 0 ;BP to last non-blank in FNAME JCLBUF: BLOCK 40. ;JCL buffer. FNAME: BLOCK 100. ;input file name CNAME: BLOCK 100. ;copy output file name CONSTANTS VARIABLES BUFPAG==<.+1777>/PG$SIZ BUFFER==BUFPAG*PG$SIZ BUFLEN==PG$SIZ-1 END GO