;-*-MIDAS-*- SUBTTL TS Definitions, parameters ; For convenience in defining isolated variables/tables, ; especially when have to know on pass1 where the ; table is going to be (.VECTOR etc don't know until end of pass) DEFINE LVAR -LINE VBLK LINE PBLK TERMIN DEFINE TMPLOC AT,STUFF %%%TLC==. ? LOC AT STUFF LOC %%%TLC TERMIN ; Nice macro for minimizing coding. Doesn't hack indirection tho. ; Could conceivably optimize to do MOVE AC,[FROM,,TO] but that ; would be overly hairy for something you can do just by writing ; 2 instructions. DEFINE BLTMAC AC,LEN,FROM,TO MOVSI AC,FROM HRRI AC,TO BLT AC,TO+LEN-1 TERMIN ; Also handy for standard zaps (and nice mnemonic) ; won't work for indirection either. DEFINE BLTZAC AC,LEN,FROM SETZM FROM IFG LEN-1,[ MOVEI AC,FROM+1 HRLI AC,-1(AC) BLT AC,FROM+LEN-1 ] TERMIN ; More convenient when A is clobberable... DEFINE BLTM LEN,FROM,TO BLTMAC A,LEN,FROM,TO TERMIN DEFINE BLTZ LEN,FROM BLTZAC A,LEN,FROM TERMIN ; Following inserts a SYSCAL for JSYS's. Be warned that it ; clobbers T when used!! IFN TNXSW,.INSRT XJSYS IFNDEF PMAPSW,PMAPSW==TNXSW ; 1 to assemble PMAP input, 0 for SIN input. IFNDEF ERRSW,ERRSW==1 ; 1 for error file output capability. IFNDEF TYPDLC,TYPDLC==7 ; Maximum total depth of .insrt (including tty) IFNDEF MX.INS,MX.INS==5 ; Maximum depth .insrt files only IFNDEF MAXIND,MAXIND==6 ; Maximum # @: table entries for .insrt ; Define sizes of various I/O buffers IFN DECSW,[ IFNDEF DECBFL,DECBFL==203 ; Standard DEC buffer size for DSK (200 wds data) IFN SAILSW,IFNDEF NINBFS,NINBFS==19. ; For SAIL, hack full disk track of input. ;;;;;FIX BY PB FOR BOTTOMS 7.01 ;;;;;;;;;; IFNDEF NINBFS,NINBFS==3 ; # standard-size buffers to use for input. IFNDEF UTIBFL,UTIBFL==*NINBFS ; Input buffs need 1 wd for EOB hacking IFNDEF UTOBFL,UTOBFL==DECBFL ; All output chans have just 1 buffer. IFNDEF CRFBSZ,CRFBSZ==DECBFL IFNDEF LSTBSZ,LSTBSZ==DECBFL IFNDEF ERRBSZ,ERRBSZ==DECBFL ] ;DECSW IFNDEF CMBFL,CMBFL==50 ; Length of command buffer. IFNDEF UTIBFL,UTIBFL==400 ; " Input buffer. IFNDEF UTOBFL,UTOBFL==200 ; " BIN output buffer. IFNDEF CRFBSZ,CRFBSZ==200 ; " CREF output buffer. IFNDEF LSTBSZ,LSTBSZ==200 ; " LIST output buffer. IFNDEF ERRBSZ,ERRBSZ==1 ; " ERR output buffer. Very small to avoid ; losing much data if things crash. ERRC==0 ; Err device input channel TYIC==1 ; TTY input channel TYOC==2 ; TTY output channel CREFC==3 ; CREF output UTYOC==4 ; BIN output LPTC==5 ; LIST output (LPT) ERRFC==6 ; ERR Assembly error output file. UTYIC==7 ; 1st input channel, UTYIC+n used for nth .INSRT level in dec version. SUBTTL File Description Storage (FILBLK's) VBLK ; Definitions for indices into a FILBLK. ; Scratch block FB is formed while defining indices... FB: OFFSET -. ; Lots of crocks depend on the exact order of these 4 items. $F6DEV:: 0 ; SIXBIT Device name $F6FNM:: $F6FN1:: 0 ; SIXBIT Filename (on ITS, FN1) $F6TYP:: $F6FN2:: $F6EXT:: 0 ; SIXBIT Extension (on ITS, FN2) $F6DIR:: 0 ; SIXBIT Directory (may be numerical PPN) L$F6BLK==. $FVERS:: $FGEN:: 0 ; File version (or generation). NUMBER, not string. IFN TNXSW,[ ; Almost all entries here are BP's to ASCIZ strings. $FDEV:: 0 ; Device name $FDIR:: 0 ; Directory name $FNAME:: 0 ; File name (i.e. main name) $FTYPE:: $FEXT:: 0 ; File type (or extension) $FTEMP:: 0 ; -1 => File is a temporary file. $FACCT:: 0 ; Account string $FPROT:: 0 ; Protection string $FJFN:: 0 ; JFN for file (may be ,,) ] IFN ITSSW\DECSW,[ $FDEV==:$F6DEV ; These definitions made so some common code can do $FDIR==:$F6DIR ; the right things. $FNAME==:$F6FNM $FTYPE==:$F6TYP $FEXT==:$F6TYP ] L$FBLK==. ; Length of a FILBLK. OFFSET 0 ; End of index definitions. ; FILBLK's for various files ISFB: BLOCK L$FBLK ; Input file specification as given in command line. INFB: BLOCK L$FBLK ; Actual current input file. OUTFB: BLOCK L$FBLK ; Output file IFN CREFSW, CRFFB: BLOCK L$FBLK ; CREF output file IFN LISTSW, LSTFB: BLOCK L$FBLK ; Listing output file IFN ERRSW, ERRFB: BLOCK L$FBLK ; Error output file INFCNT: 0 ; AOS'd each time an input file is opened. INFCUR: 0 ; What INFCNT was when current file opened. INFERR: 0 ; What INFCUR held at last err msg. INDDP: MAXIND,,TBLOFS ; Pointer into tables below TBLOFS: BLOCK MAXIND*L$FBLK ; Actual filenames corresponding to those in TBLSFS, for opening. TBLSFS: BLOCK MAXIND*L$FBLK ; Source-specified filenames for @: files RFNAM1: 0 ; .FNAM1, .FNAM2, .FVERS RFNAM2: 0 RFVERS: 0 IFNM1: 0 ; .IFNM1, .IFNM2, .IFVRS IFNM2: 0 IFVRS: 0 INFFN1==:INFB+$F6FN1 ; Some crocks seem to reference this. OFNM1==:OUTFB+$F6FN1 ; Pseudo .OFNM1 needs this. OFNM2==:OUTFB+$F6FN2 ; ditto, .OFNM2 RSYSNM: 0 ; Initial system name PBLK SUBTTL I/O Buffers VBLK ; Input buffer and variables UTIBUF: BLOCK UTIBFL UTIHDR: 0 ; Input buffer header (dec version) UREDP: 440700,,UTIBUF ; Input byte pointer UTICNT: 0 ; Input byte count (dec version) IUREDP: 440700,,UTIBUF ; Initial UREDP, used for re-initializing. UTIBED: UTIBUF ; EOF comparison with RH(UREDP), 4.9 => EOF on .IOT IFN DECSW,UTICHN: UTYIC ; BIN Output buffer UTOBUF: BLOCK UTOBFL ; Output buffer UTOHDR: UTOBFL,,UTOBUF-1 UTYOP: 444400,, ; Output (36. bit) byte pointer UTYOCT: 0 ; # words left in utobuf IFN ITSSW,OCLOSP: @1(C) ; Turned into bp to unused part of last bffer wd used. ; CREF output buffer IFN CREFSW,[ CRFBUF: BLOCK CRFBSZ CRFHDR: CRFBSZ,,CRFBUF-1 ; Header, assembled value used only ifn itssw CRFPTR: 444400,, ; Bp for filling buffer (full words) CRFCNT: 0 ; Num. wds. empty in buffer ] ; LISTing output buffer IFN LISTSW,[ LSTBUF: BLOCK LSTBSZ LSTHDR: 5*LSTBSZ,,LSTBUF-1 LSTPTR: 440700,, LSTCNT: 0 ] ; ERRor output buffer IFN ERRSW,[ ERRBUF: BLOCK ERRBSZ ERRHDR: 5*ERRBSZ,,ERRBUF-1 ERRPTR: 440700,, ERRFCT: 0 ; Can't call this ERRCNT since that's used for # errors. ERRFP: 0 ; Non-0 if want error output file. ERRFOP: 0 ; Non-0 if error file open (ie try outputting to it) ] PBLK SUBTTL Interrupt Handling ; Note that only PDL OV is now enabled in general. ; TTY input interrupts are also handled when possible for ; ^H, ^W, and ^V. .SCALAR INTSVP ; Saves P on interrupt for debugging IFN ITSSW,[ TMPLOC 42, JSR TSINT ; Interrupt vector for ITS VBLK .JBCNI: TSINT: 0 ; 1st wd interrupts currently considered fatal errors. .JBTPC: 0 ; Error processor re-enables interrupts .SUSET [.RJPC,,INTJPC] SKIPGE TSINT JRST TTYINT ; Second-word ints. JRST TSINT1 ; Jump into pure coding and process interrupt INTJPC: 0 ; Saves .JPC at interrupt. PBLK ; Jrst here from TSINT for 2nd wd interrupts. TTYINT: PUSH P,A MOVEI A,TYIC ; The tty chnl is the only one enabled. .ITYIC A, JRST TTYINX ; No int. char. CAIN A,^W AOS TTYFLG ; ^W silences, CAIN A,^V SOS TTYFLG ; ^V unsilences, CAIN A,^H SETOM TTYBRF ; ^H says break next time thru ASSEM1 loop. TTYINX: REST A .DISMIS .JBTPC ] ; IFN ITSSW IFN DECSW, TMPLOC .JBAPR, TSINT1 ; Interrupt vector for DEC IFN ITSSW\DECSW,[ ; Amazing but can use almost same basic rtn for both! TSINT1: MOVEM P,INTSVP ; Save P for possible debugging IFN ITSSW,.SUSET [.SPICL,,[-1]] ; For ITS, re-enable ints. MOVE A,.JBCNI ; Get interrupt request word TRNE A,200000 ; PDL overflow? JRST CONFLP MOVE B,[TYPE "Unknown interrupt - Fatal"] ; anything else. MOVEM B,40 MOVE A,.JBTPC ; So error routine will print out properly JSA A,ERROR ] IFN TNXSW,[ ; TENEX Interrupt handler ; Note that NXP (non-ex page) is enabled, but no provision is ; currently made for handling it. This causes process termination and ; EXEC will print error message. If NXP wasn't enabled, a page would ; simply be created without fuss (page is always created, incidentally, ; whether or not interrupt happens) LVAR MEMDBG: 0 ; For nonce, this gets set when PURIFG does. LEVTAB: INTPC1 ; Where to store PC for level 1 interrupt. 0 ? 0 ; Levels 2 and 3 unused. CHNTAB: BLOCK 36. ; Where to go for indicated condition. Most zero. .IC.CV==1 ; Define user channel 1 for ^V interrupt .IC.CW==2 ; " 2 for ^W .IC.CH==3 ; " 3 for ^H %%LSV==. LOC CHNTAB+.ICPOV ? 1,,TSINT1 ; Put right word in CHNTAB for PDL OV dispatch. LOC CHNTAB+.IC.CV ? 1,,INT.CV ; Ditto for ^V dispatch LOC CHNTAB+.IC.CW ? 1,,INT.CW ; " ^W LOC CHNTAB+.IC.CH ? 1,,INT.CH ; " ^H LOC %%LSV .SCALAR INTPC1 ; Level 1 interrupt PC stored here. ; Handle PDL OV interrupt TSINT1: MOVEM P,INTSVP ; Save PDL ptr. MOVEI A,CONFLP ; OK to clobber A in PDLOV. MOVEM A,INTPC1 ; Dismiss to CONFLP. DEBRK ; Off we go. ; Handle ^V interrupt INT.CV: SOS TTYFLG ; Unsilence typeout DEBRK ; Handle ^W INT.CW: AOS TTYFLG ; Silence typeout DEBRK ; Handle ^H INT.CH: SETOM TTYBRF ; Set flag to check at main level ASSEM1 loop. DEBRK ] SUBTTL MIDAS BEGINS HERE - Program Startup VBLK NVRRUN: -1 ; 0 => MIDAS was run; error to start or purify. FATAL: 0 ; At end of assembly, not 0 iff fatal error occurred. PBLK BEG: ; Start address! IFN DECSW\TNXSW,[ TDZA A,A SETO A, MOVEM A,CCLFLG ; Remember type of start-up ] SETZ FF, ; Initialize flags MOVE P,[-LPDL,,PDL-1] ; Initialize P IFN DECSW,[ RESET MOVEI A,600000 APRENB A, ] ; For TENEX, must determine right away which system we're on. IFN TNXSW,[ RESET ; TLZ FF,FL20X ; Assume 10X until proven otherwise. (done by SETZ above) IFN 0,[ ; One way of determining OS which doesn't work on some places. MOVE A,[112,,11] ; Magic word that will win on 10X,T20 (and maybe T10) GETTAB=<047000,,41> ; CALLI 41 GETTAB A, ; Returns 10000 T10, 20000 ITS, 30000 10X, 40000 T20 MOVEI A,30000 ; Shouldn't ever fail, but if it does, assume 10X. LDB A,[140300,,A] ; Flush other fields too CAIN A,4 ; = Tops-20? TLO FF,FL20X ; Yes, set flag. ]; IFN 0 IFN 0,[ ; This is a loser too, since there ARE KL Tenices! SETZ A, ; In lieu of above, use hardware hack... BLT A, ; test for KL-ness. CAIE A, TLO FF,FL20X ; KL will fail to skip, assume that means 20X OS. ];IFN 0 IFN 1,[ ; Boy I hope DEC never defines LOADTB! -- MRC SYSCAL SYSGT,[['LOADTB]][A ? D] SKIPN D ; If LOADTB is not defined TLO FF,FL20X ; it must be a Twenex ]; IFN 1 SYSCAL SCVEC,[[.FHSLF] ? [-1]] ; and flush compat package, ; disabling UUO's 40-77; this is good for debugging. ; Set up stuff for interrupts SYSCAL SIR,[[.FHSLF] [LEVTAB,,CHNTAB]] ; Specify tables SYSCAL EIR,[[.FHSLF]] ; Enable interrupts SYSCAL AIC,[[.FHSLF] ; Activate PDL OV and ^V, ^W, ^H [IRP BIT,,[.ICPOV,.IC.CV,.IC.CW,.IC.CH] <1_<35.-BIT>>+!TERMIN ]] SYSCAL ATI,[[.TICCV,,.IC.CV]] ; Make various mappings from SYSCAL ATI,[[.TICCW,,.IC.CW]] ; terminal bits to int. channels. SYSCAL ATI,[[.TICCH,,.IC.CH]] ; What a losing interrupt sys 10X has! SKIPN MEMDBG ; Hacking memory? JRST BEG20 MOVSI A,-2*MINMAC ; If so, must create pages for initially-zero MOVE B,(A) ; core, by referencing them all. ADDI A,777 AOBJN A,.-2 SYSCAL AIC,[[.FHSLF] ? [1_<35.-.ICNXP>]] ; Then enable ints BEG20: ; for Non-eXistent Pages. ] IFN ITSSW,[ MOVE A,[-5,,[ ; Set and read various vars in a chunk. .SMASK,,[%PIPDL] ; 1st-wd Interrupt only on PDL ovfl. .SMSK2,,[1_TYIC] ; 2nd-wd on TTY input channel. .SPICL,,[-1] ; and enable interrupt system. .RSNAM,,RSYSNM ; Get system name (default dir to use) .RXJNAM,,B ]] ; and XJNAME for temp. hacking below. .SUSET A SYSCAL TTYSET,[1000,,TYIC ; Set TTYST wds - PI echo, no act/int [232020,,202020] ; except ctls activate & interrupt [232020,,220220]] ; CR, DEL activate but don't int; ; DEL doesn't echo. ] AOSE NVRRUN ; Test for this job's already being run... JRST [ TYPE "Can't restart MIDAS" JRST TSRETN] MOVEI D,SYMDSZ ; Get default symtab size IFN ITSSW,[ ; Remember that B set to XJNAME above. CAME B,['MMIDAS] ; Set symtab size larger for MMIDAS CAMN B,[SIXBIT/MM/] ; (random sort of hack now that .SYMTAB exists) MOVEI D,SYMMSZ ] SKIPGE ISYMF ; The first time through, MOVEM D,SYMLEN ; Make that the size to use. CALL SITINI ; Initialize stuff for .SITE. CALL JCLINI ; Now try to fetch JCL; set CMPTR accordingly. IFN ITSSW,[ SKIPGE ISYMF ; Skip if syms spread; if not, CALL TSYMGT ; get TS syms from system. ] SKIPE CMPTR ; If have JCL, JRST GO2AA ; skip announcing midas's name and version. IFG PURESW-DECSW,[ ; If meaningful, SKIPGE PURIFG ; Check for purity TYPE "NOTPUR " ; and type little warning if unpurified. ] TYPE "MIDAS." ; and announce self. MOVE B,[MIDVRS] PUSHJ P,SIXTYO JRST GO2AA SUBTTL MIDAS Top-level control path GO2A: SETZM CMPTR ; Recycles here, so JCL only hacked once. GO2AA: SETOM FATAL ; Assume fatal errors, unless cleared at GO8 when done. SETZM TTYFLG ; Allow TTY typeout. SETZM ERRCNT ; Initialize error counter (total errors) IFN RUNTSW,[ PUSHJ P,RNTTMA ; Get initial run time. MOVEM A,IRUNTM] SETZM LSTTTY ; Tell TYOERR not to try output to LST file (none yet!) PUSHJ P,CMD ; Get typed in command (or scan cmd line if CMPTR ne 0) SKIPGE SMSRTF ; What's this for, I wonder? JRST GO21 TYPECR "SYMTAB clobbered" JRST GO2A ; Filenames and switches all specified, now see if files can be set up. GO21: PUSHJ P,OPNRD ; Open input file JRST GO2A ; Error, msg was typed, go try again with new cmd line. PUSHJ P,WINIT ; Open output file, cref file. IFN DECSW\TNXSW,[ SKIPGE CCLFLG TYPE "MIDAS: " ] IFN A1PSW,[ SETOM PRGC SETOM OUTC GO3: ] MOVE A,WSWCNT MOVEM A,TTYFLG ; Turn off typeout if there were (W) switches. SETOM LSTTTY ; Allow TYOERR to output to both TTY and LST. JSP A,$INIT ; Initialize for assembly JSP A,PS1 ; Do pass 1 TRNN FF,FRNPSS ; If 2 pass assembly, JRST GO4 PUSHJ P,OPNRD ; Then re-open input file JRST GO2A ; Couldn't re-open???? Do something better here. GO4: JSP A,PLOD ; Maybe punch out SBLK loader in some format JSP A,PS2 ; Do pass 2 JSP A,PSYMS ; Maybe punch out symbol table IFN A1PSW,[ TLZ FF,$FLOUT AOS PRGC ; Indicate end statement encountered SETOM OUTC ; " " " TRNN FF,FRNPSS ; If 1 pass assembly, SKIPGE CONTRL CAIA JRST GO3 ; Then try to assemble another program ] IFN FASLP,[ SKIPGE A,CONTRL TRNN A,FASL JRST GO8 MOVE A,[SIXBIT /*FASL*/] ; "finish" FASL file MOVEI B,17 PUSHJ P,FASO ; Ignore end frob, but output FASL end code MOVE A,[ASCIC//] ; pad with ^C's. PUSHJ P,FASO1 ; Randomness PUSHJ P,FASBE ; Write out last block ] ; Jump directly here for certain main-input EOF conditions. GO8: SETZM FATAL ; There was no fatal error: output files get renamed. ; Jump directly here if hit fatal error (incl .FATAL, illegal UUO, etc) GO9: PUSHJ P,.FILE ; Close (and rename if FATAL = 0) output files. SETZM LSTTTY IFN RUNTSW, PUSHJ P,RNTTYO ; Type out run time used since GO2A CALL ERRCLS ; File away error file - only thing not closed by .FILE JRST TSRETN ; and die according to system's wishes. SUBTTL MIDAS Death (TSRETN) - system dependent exit routines IFN ITSSW,[ TSRETN: IFN PURESW,[ SKIPGE PURIFG ; If not yet purified, assume being debugged. .VALUE ] .LOGOUT ; Come here to commit suicide. .BREAK 16,160000 ] ;IFN ITSSW IFN DECSW,[ TSRETN: SKIPLE A,ERRCNT ; If had any errors, ADDM A,.JBERR ; let loader know about them. (???) Well, .SEE ERR1 ; for strange comment. SKIPN CCLMOR ; Any more CCL commands? EXIT ; Nope, all done. JRST RERUN ; More CCL to hack, start up a new MIDAS. ] ; IFN DECSW IFN TNXSW,[ TSRETN: SKIPE CCLMOR ; Need to hack any more CCL? JRST RERUN ; Yeah. TSRET1: HALTF HRROI 1,[ASCIZ/Can't continue/] PSOUT ; Better than dying randomly JRST TSRET1 ] ; IFN TNXSW SUBTTL .SITE pseudo & initialization (SITINI) IFN ITSSW, LVSITE==1 ; ITS only uses 1 word of mach name. IFN DECSW\TNXSW,LVSITE==5 ; whereas others need 5 words (25 chars max) LVAR V.SITE: BLOCK LVSITE ; .SITE string stored here. ; .SITE N, returns nth word of sixbit machine name. A.SITE: CALL AGETFD ; Get field as argument. JUMPL A,CABPOP ; Ignore negative indices. CAIL A,LVSITE ; Make sure index is within bounds of string. JRST CABPOP MOVE A,V.SITE(A) ; Win, get indexed word. JRST CLBPOP ; SITINI - Initialization routine called only at MIDAS startup, for ; setting up .SITE and maybe other things. SITINI: BLTZ LVSITE,V.SITE ; Clear out string location IFN ITSSW,[ ; For ITS, use up just 1 word and need 1 call to set V.SITE SYSCAL SSTATU,[REPEAT 5,[ ? MOVEM A] ? MOVEM V.SITE] .LOSE %LSSYS POPJ P, ] IFN SAILSW,[ ; SAIL needs special kludge, since it doesn't have the MOVE A,[SIXBIT /SAIL/] ; right GETTAB used. MOVEM A,V.SITE POPJ P, ] ; This code sets TNX .OSMIDAS at runtime as appropriate. IFN TNXSW,[ MOVE A,[SIXBIT /TENEX/] ; Assume running on 10X TLNE FF,FL20X ; unless proved otherwise MOVE A,[SIXBIT /TWENEX/] MOVEM A,OSMID ; Store directly as symtab value! ] ; If TNX and on ARPA network, get Arpanet host name for .SITE IFN TNXSW,[ SYSCAL SYSGT,[['LHOSTN]][A ? B] ; Get local host # JUMPL A,SITIN3 ; Tops-20 release 3 has a LHOSTN table JUMPE B,SITIN3 ; Jump if none, not on net. SYSCAL CVHST,[FNBWP ? A][A] ; Write string into FNBUF. JRST SITIN3 ; No string for that host #?? SETZ B, IDPB B,A ; Make sure string is ASCIZ'd. MOVE B,FNBWP ; Note that FNBWP isn't altered by the syscal! MOVE C,[440600,,V.SITE] SITIN2: ILDB A,B JUMPE A,APOPJ ; return when string ended. TRCE A,140 ; Convert char to sixbit. TRCE A,140 TRCE A,140 IDPB A,C JRST SITIN2 ] ; For non-network TENEX and DEC in general, very similar. IFN DECSW\TNXSW,[ IFN TNXSW,[ SITIN3: SYSCAL SYSGT,[['SYSVER]][A ? D] ; Best to get table index dynamically, JUMPE D,APOPJ ; If can't, lose. ] IFN DECSW,MOVEI D,11 ; 11 = .GTCNF But on T10 we can assume this. MOVE AA,[440600,,V.SITE] MOVSI C,-5 ; Process 5 words of .GTCNF (max possible) SITIN4: HRLZ B,C ; Get subindex we want, HRRI B,(D) ; and produce ,, IFN DECSW, GETTAB B, ; Get 1 word of table, using appropriate call. IFN TNXSW, SYSCAL GETAB,[B][B] POPJ P, ; If call fails, exit. SITIN5: SETZ A, LSHC A,7 ; Extract an ascii char CAIE A,", ; If it's a comma, CAIG A,40 ; or ctl or space, POPJ P, ; then let's stop. TRCE A,140 ; Swap bit 40 with bit 100, thus turning TRCE A,140 ; "A to 'A, "a to 'A, "1 to '1, etc, and ^@ to ' . TRCE A,140 IDPB A,AA ; Store the sixbit into V.SITE JUMPN B,SITIN5 ; When nothing left of this word of .GTCNF, get next. AOBJN C,SITIN4 POPJ P, ] ;DECSW\TNXSW SUBTTL RunTime - .MRUNT and end-of-assembly typeout IFN RUNTSW,[ .SCALAR IRUNTM ; Holds initial run time (set at start of assembly) ; .MRUNT - Returns runtime since start of assembly. A.MRUN: PUSHJ P,RNTTMA ; Get current run time SUB A,IRUNTM ; Subtract initial run time IFN ITSSW,[MULI A,4069. ; ITS - Convert to nanoseconds, DIV A,[1.^6] ; then to milliseconds. ] PJRST CLBPOP ; RNTTMA - internal routine to return in A the current runtime, ; in whatever units the OS furnishes. RNTTMA: IFN ITSSW, .SUSET [.RRUNT,,A] ; Gets runtime in 4.096 usec units. IFN DECSW, SETZ A, ? RUNTIM A, ; Runtime in msec IFN TNXSW,[ IFN A-1, EXCH R1,A MOVEI R1,.FHSLF RUNTM ; Runtime in msec for self. IFN A-1, EXCH R1,A ] POPJ P, ; RNTTYO - Called at end of assembly to type out runtime, ; # of errors, and # symbols used. RNTTYO: IFN DECSW,[ ; Nobody wants this on ITS, but other people do...sigh... SKIPE A,ERRCNT ; Any assembly errors? JRST [ TYPE "? " ; Yes, error message for batch controllers CALL DPNT TYPECR " error(s) detected" JRST .+1] SKIPE CCLFLG ; Called via CCL? RET ] TYPE "Run time = " CALL A.MRUN ; Get runtime in millisec. in A. IDIVI A,10. IDIVI A,100. ; Get secs and hundredths. HRLM B,(P) ; Save remainder PUSHJ P,HMSTYO ; Type out secs MOVEI A,". CALL TYO HLRZ A,(P) CALL HMSTY3 ; Type out hundredths CALL CRR CALL A.SYMC CALL DPNT TYPE " Symbols including initial ones (" CALL A.SYMC IMULI A,100. IDIV A,SYMLEN ; Get % symtab used CALL DPNT TYPECR "% used)" RET ; HMSTYO - Type out H:MM:SS time in A ; Doesn't work for times .ge. 60. hours HMSTYO: IDIVI A,60. JUMPE A,[MOVE A,B ? PJRST DPNT] HRLM B,(P) PUSHJ P,HMSTYO MOVEI A,": PUSHJ P,TYO ; Type delimiting char HLRZ A,(P) HMSTY3: IDIVI A,10. PUSHJ P,ADGTYO ; Type out digit in A MOVEI A,"0(B) PJRST TYO ] ; IFN RUNTSW SUBTTL COMMON Output Routine WINIT - Open all output files. ; WINIT - Called from top-level control to open all necessary output files. ; WINIT: IFN ERRSW,[ SKIPN ERRFP ; If want error output file, JRST WINIT2 CALL OINIT ; Open it, first of all. 0 ERRFC,ERRFB SIXBIT/ERROUT/ ERRHDR,,ERRBUF SETOM ERRFOP ; Error file now open. WINIT2: ] PUSHJ P,OINIT ; Open main output file. 13^9 UTYOC,OUTFB ; chnl,name-block. SIXBIT/OUTPUT/ UTOHDR,,UTOBUF IFN ITSSW,[ TLZ FF,FLPTPF ; Initially assume device not paper tape punch .STATUS UTYOC,A ; Get status of output channel ANDI A,77 ; Mask to device code CAIN A,7 ; If paper tape punch, TLO FF,FLPTPF ; Then set FLPTPF. ] IFN LISTSW,[ SKIPN LISTP JRST WINIT1 CALL OINIT ; Open listing file if desired. 0 LPTC,LSTFB SIXBIT/LSTOUT/ LSTHDR,,LSTBUF WINIT1: ] IFN CREFSW,[ SKIPN CREFP ; If cref requested, RET PUSHJ P,OINIT ; Open cref file, FN2 = CRFOUT 13^9 CREFC,CRFFB SIXBIT/CRFOUT/ CRFHDR,,CRFBUF MOVE A,[.BYTE 7 ? 177 ? "B ? ^W] PUSHJ P,CRFOUT ; Output header to indicate image input. PUSHJ P,CRFSSF ; Output set-source-file block. ] RET SUBTTL COMMON Output Routines - Output Chars/Words to BIN, TTY, ERR, CREF, LIST ; PPB - Punch Binary word. PPB: JUMPGE FF,CPOPJ ; Don't punch if not punching pass. PPBA: ; This entry pt "Always" punches. TPPB: SOSGE UTYOCT ; If no more room in buffer, JRST [ CALL TPPBF ; Output & re-init buffer. JRST TPPB] IDPB A,UTYOP RET TPPBF: PUSH P,[0 UTYOC,UTOHDR] ; Drop thru to COBUFO. ; Common OBUFO. Takes ,
on stack, clobbers no ACs. ; See rtns below for usual calling sequence. COBUFO: EXCH C,(P) ; Get arg off stack, save C. CALL OBUFO ; Output & re-init buffer. REST C RET ; TYO - Output char in A, outputting also to ERR file if possible. TAB: MOVEI A,^I TYO: SKIPG A.TTYF CALL TYOX ; Actually output to TTY with OS-dependent routine. ; Then fall through for ERR output. ERRCHR: IFE ERRSW,RET IFN ERRSW,[ SKIPN ERRFOP ; Output char in A to error file if one is open. RET SOSGE ERRFCT JRST [ PUSH P,[ERRCHR] PUSH P,[0 ERRFC,ERRHDR] PJRST COBUFO] IDPB A,ERRPTR RET ] ;IFN ERRSW ; CRFOUT - Output word in A to CREF file. IFN CREFSW,[ CRFOUT: SOSGE CRFCNT JRST [ PUSH P,[CRFOUT] ; Buffer full, go output it. PUSH P,[0 CREFC,CRFHDR] PJRST COBUFO] IDPB A,CRFPTR POPJ P, CRFSSF: SKIPA A,[1] ; Output set-source-file block. CRFPSH: MOVEI A,3 ; Output push-source-file block. REPEAT L$F6BL,[ CALL CRFOUT MOVE A,INFB+$F6DEV+.RPCNT ] JRST CRFOUT ] ; IFN CREFSW ; PILPT - Output character in A to listing file. IFN LISTSW,[ PILPT: SOSGE LSTCNT JRST [ PUSH P,[PILPT] ; When buffer full, output it. PUSH P,[0 LPTC,LSTHDR] PJRST COBUFO] IDPB A,LSTPTR RET LPTCLS=:CPOPJ ; Hmmm, random noop-ness ref'd by AEND. ] ;END IFN LISTSW, SUBTTL COMMON Output Routine .FILE - Close all output files. ; .FILE - Counterpart to WINIT. ; Close input, bin, cref and list files. .FILE: ; Closing input file is simple enough... IFN DECSW, RELEAS UTYIC, IFN ITSSW, .CLOSE UTYIC, IFN TNXSW,[ IFN PMAPSW, MOVE A,[NIBFPS,,1STBFP] ? CALL DELPGS ; flush buffer pages MOVE R1,INFB+$FJFN CLOSF JFCL SETZM INFB+$FJFN SETZM JFNCHS+UTYIC ] MOVNI A,1 SKIPL B,CONTRL ; If relocatable, PUSHJ P,TPPB ; Output a -1 so stink will see EOF SETZ A, ; In dec fmt, output a 0 at end. TRNE B,DECREL CALL TPPB SKIPE OUTFB+$FEXT ; Check general name. JRST .FILE2 ; Output fnam2 was explicitly specified ; Output extension (fn2) wasn't specified, default depends ; on system and output type. IFN ITSSW, MOVSI A,'BIN ; Default to SBLK output format; note that IFE ITSSW, MOVSI A,'SBK ; this will include RIM, RIM10. SKIPL B,CONTRL ; Using STINK output format? IFN ITSSW, MOVSI A,'REL ; Yes, use appropriate thing for site. IFE ITSSW, MOVSI A,'STK TRNE B,DECSAV ; Using DECSAV output format? MOVSI A,'SAV IFN TNXSW,[ TRNE B,DECSAV ; If using DECSAV format and TLNN FF,FL20X ; on a 20X, then CAIA MOVSI A,'EXE ; use this extension instead. ] TRNE B,DECREL ; Using DECREL output format? MOVSI A,'REL IFN FASLP,[ TRNE B,FASL ; Using FASL output format? IFN ITSSW, MOVE A,[SIXBIT /FASL/] ; yes, smash as appropriate. IFE ITSSW, MOVSI A,'FAS ] IFE TNXSW, MOVEM A,OUTFB+$F6EXT ; For 6bit systems, store final selection. IFN TNXSW, PUSHJ P,TNXODF ; If Tenex, call output default hackery, since ; changing stuff is a bit hairier. .FILE2: JSP A,OCLOSE 0 UTYOC,UTOHDR ; Write out buffer, rename and close output file. OUTFB IFN LISTSW,[ SKIPN LISTP ; Listing file open => JRST .FILE3 CALL PNTCR ; End with cr and ff. MOVEI A,^L CALL PILPT PUSH P,FATAL ; Rename listing file even if fatal error. SETZM FATAL JSP A,OCLOSE 0 LPTC,LSTHDR ; Output buffer, rename & close it. LSTFB POP P,FATAL .FILE3: ] ;IFN LISTSW IFN CREFSW,[ SKIPN CREFP ; If cref file open, POPJ P, MOVEI A,0 PUSHJ P,CRFOUT ; Output eof block, JSP A,OCLOSE ; Write buffer, close. 0 CREFC,CRFHDR ; 0 chnl,header CRFFB ] RET ; File out error output file. This isn't done in .FILE so that ; error file can include a few more goodies and be closed separately ; later on. ERRCLS: SETZM FATAL ; Err file renamed even after fatal error. IFN ERRSW,[ SKIPN ERRFOP RET ; There is none. MOVEI A,^M CALL ERRCHR ; Put crlf at ennd. MOVEI A,^J CALL ERRCHR JSP A,OCLOSE ; Rename and close. 0 ERRFC,ERRHDR ERRFB SETZM ERRFOP ] RET SUBTTL ITS - Output file Open, Output, Close/Rename. IFN ITSSW,[ ; PUSHJ P,OINIT ; Open output file ; Mode chnl,name-block-addr ; Sixbit/desired-temporary-fn2/ ; Header,,buffer space ;used only in dec version. ; The mode should be 13^9 for binary, 0 for ascii. OINIT: MOVE A,(P) HLRZ B,2(A) ; Get addr of header, SETOM 2(B) ; Set buffer byte count to -1 => not initted. MOVE AA,1(A) ; Get 2nd arg, temp FN2 to use. MOVE F,(A) ; Get 1st arg - , SYSCAL TRANS,[5000,,.UAO ; For output mode, REPEAT 4,[? .RPCNT(F) ] ; translate from given names REPEAT 4,[? MOVEM .RPCNT+FB+$F6DEV ]] ; into actual names, in scratch blk. JRST OINITL ; (too many translations) SYSCAL DELETE,[FB+$F6DEV ; Delete old temp name file. TMPFN1 ? AA ? FB+$F6DIR] JFCL ; If none, it's ok. LDB A,[270400,,F] ; Get channel num. HRLI A,.BAO ; Open mode (default ascii) TLNE F,777000 ; But maybe want image mode. HRLI A,.BIO ; Yep, use that instead, to get ,, SYSCAL OPEN,[A ? FB+$F6DEV ; Open file, TMPFN1 ? AA ; using these temp filenames. FB+$F6DIR] JRST OINITL BLTM L$F6BL,FB+$F6DEV,$F6DEV(F) ; Copy translated names into ; name-block for file, for eventual rename. POPJ3: AOS (P) ; Skip over 3 args. POPJ2: AOS (P) JRST POPJ1 TMPFN1: SIXBIT /_MIDAS/ ; FN1 to use for temp filenames. ; OINITL - jumped to from OINIT if some lossage ; encountered when opening output files. OINITL: HLLZ A,@(P) ; Get chnl num, TLZ A,777037 ; Mask to just ac field (chnl num) IOR A,[.STATUS A] XCT A ; Read its status, PUSHJ P,OPNER ; Type out reason for open failure, and ask TYPE "Use what filename instead? " PUSHJ P,GTYIP ; Get typein, one line. MOVE F,@(P) ; Get PUSHJ P,RFD ; Get new file description into filblk spec'd by F JRST OINIT ; and jump back to try again. VBLK ERRDNM: .UAI,,'ERR ? 3 ERRCOD: 0 IFSTS: 0 ; .STATUS word stored by OPNRD1 when .OPEN loses PBLK ; Openloss documentation routine IOPNER: MOVE A,IFSTS ; Input OPNER: MOVEM A,ERRCOD ; Save .status word PUSHJ P,TYPFB ; Type out file description PUSHJ P,CRRERR ; Now crlf to ensure room for following .OPEN ERRC,ERRDNM ; Now get the system to say what's wrong .LOSE %LSSYS ; Can't open err device? IOPNR2: .IOT ERRC,A ; Get character from system CAIGE A,40 ; Ends with ^L or ^C or other cruft. PJRST CRRERR ; Return, typing out CRLF. PUSHJ P,TYOERR ; Type out character JRST IOPNR2 ; Loop back for next ; JSP A,OCLOSE ; 0 chnl,header ; Nameblockaddr ; Write out last buffer, rename to names in nameblock and close. OCLOSE: MOVE C,(A) ; 1st wd of args is what OBUFO wants. LDB B,[360600,,1(C)] ; Just in case this is ascii file, DPB B,[300600,,OCLOSP] ; Get bp to unused part of last wd of buffer, MOVE B,[ASCIC//] DPB B,OCLOSP ; And pad with ^c's. SOS 2(C) ; Obufo assumes byte count was sos'd. CALL OBUFO ; Write out last partial buffer MOVE F,1(A) ; Get LDB C,[270400,,(A)] ; Get chnl num. SKIPE FATAL JRST OCLOS1 ; After fatal error, don't rename outputfiles. SYSCAL RENMWO,[C ; Rename (F has nameblock addr) $F6FN1(F) ? $F6FN2(F)] HALT OCLOS1: SYSCAL CLOSE,[C] ; Close channel. HALT JRST 2(A) ; Skip over args on return. ; OBUFO - Write out and reinitialize buffer for file. ; Assumes byte count (header 3rd wd) was sos'd. ; C has <0 chnl,header> ; In ITS version, header 1st wd has ,,-1 OBUFO: PUSH P,A PUSH P,AA AOSGE 2(C) ; Was count sos'd from -1? JRST OBUFO1 ; Yes, buffer hadn't been initted, don't write it. MOVN A,1(C) ADD A,(C) ; RH(A) has -<# wds used in buffer>. MOVSI A,(A) HRR A,(C) AOS A ; A has aobjn -> used part of buffer. HLLZ AA,C IOR AA,[.IOT A] CAIGE A, XCT AA ; Write it in file. OBUFO1: MOVE A,1(C) HRR A,(C) ; Position the b.p. before start of buffer, TLZ A,770000 ; After last byte in wd (idpb will use 1st buffer wd) MOVEM A,1(C) HLRE A,(C) MOVEM A,2(C) ; Set up byte count. REST AA JRST POPAJ TFEED: TLNN FF,FLPTPF ; If output device not PTP, POPJ P, ; Then do nothing PUSHJ P,TPPBF ; Otherwise output the buffer, TFEED1: .FEED UTYOC, ; Feed a line, TLZA FF,FLPTPF ; If this is executed, utyoc doesn't have ptp after all SOJG B,TFEED1 ; Feed the specified number of lines, POPJ P, ; And return ] ; IFN ITSSW SUBTTL DEC - Output file Open, Output, Close/Rename IFN DECSW,[ OINIT: MOVE AA,(P) MOVE F,(AA) ; Get , HLLZ TT,F TLZ TT,#(0 17,) ; Mask off AC field in TT HRRZ D,2(AA) ; Get buffer space addr. HLLZ C,2(AA) ; Get header addr. HLRZ A,C SETZM (A) ; Clear out its-version contents of 1st header wd. LDB A,[331100,,F] ; Get mode to open in (will be ascii or image binary) IOR TT,[OPEN A] ; Cons up OPEN instruction for chan, MOVE B,$F6DEV(F) ; and bring in last arg. XCT TT ; Open channel,a JRST OINITL ; Lost? PUSH P,.JBFF ; Now to fake out DEC system into consing up buffer MOVEM D,.JBFF ; at this location. T10 uses .JBFF as pointer. XOR TT,[#] ; Request buffer setup (one of) XCT TT REST .JBFF MOVE A,[SIXBIT /000MD /] PJOB B, ; Get job number, to make sixbit /md/ IDIVI B,10. DPB C,[220400,,A] IDIVI B,10. DPB C,[300400,,A] ; Put the digits of the job number into the sixbit word. DPB B,[360400,,A] MOVE AA,(P) LDB B,[360600,,1(AA)] ; Get 1st char of 'output, 'lstout, 'crfout, 'errout. IOR A,B ; Use it as last char of temp file name. MOVSI B,'TMP ; Set up ext (fn2), SETZ C, ; zap prot/date/time etc to default, MOVE D,$F6DIR(F) ; and PPN. XOR TT,[#] XCT TT ; Do ENTER UTYOC,A JRST OINITL POPJ3: AOS (P) POPJ2: AOS (P) JRST POPJ1 ; OINITL - jumped to from OINIT if some lossage ; encountered when opening output files. Jumps back to OINIT ; directly. OINITL: PUSHJ P,OPNER ; Type out reason for open failure, and ask: TYPE "Use what filename instead? " PUSHJ P,GTYIP ; Get typein, one line. PUSHJ P,RFD ; Get new file description into filblk spec'd by F JRST OINIT ; and jump back to try again. ; Openloss documentation routine - not much to say. IOPNER: ; Input OPNER: PUSHJ P,TYPFB ; Type out file description PUSHJ P,CRRERR ; Now crlf to ensure room for following TYPE "OPEN failed" PJRST CRRERR ; Return, typing out another CRLF. ;CLOSE AN OUTPUT FILE, SEE NON-DEC VERSION FOR ARGS. OCLOSE: PUSH P,A ; Save return addr MOVE F,1(A) ; Get SKIPGE FATAL ; If fatal error happened, JRST OCLOS2 ; don't rename, just close. MOVE C,$F6DEV(F) ; Delete any file with names SETZB B,D ; we want to rename to. OPEN ERRC,B ; Use ERRC as temporary channel. JRST OCLOS1 MOVE A,$F6FN1(F) HLLZ B,$F6EXT(F) SETZ C, MOVE D,$F6DIR(F) LOOKUP ERRC,A JRST OCLOS1 ; There is none, just rename. SETZ A, ; Say to delete this file MOVE D,$F6DIR(F) ; From right UFD RENAME ERRC,A JFCL RELEAS ERRC, OCLOS1: MOVE A,$F6FN1(F) ; Desired fn1. HLLZ B,$F6EXT(F) ; Desired fn2. SETZ C, ; Bottoms-10 DATE75 lossage must never be forgotten! MOVE D,$F6DIR(F) ; Sname (that is, ppn) HLLZ AA,@(P) ; Get just chnl num. IOR AA,[CLOSE] ; Close it & finalize, XCT AA XOR AA,[CLOSE#] XCT AA ; Then rename to desired names. JFCL ; at this point, ignore any lossage, sigh. OCLOS2: HLLZ B,@(P) ; Get chnl in ac field. IOR B,[RELEAS] XCT B ; Finally, release channel. JRST POPJ2 ; and skip over args on return. ; Write out buffer of output file, C has <0 chnl,header> OBUFO: AND C,[0 17,] ; Get just chnl num. (sys remembers where header is for ch) TLO C,(OUT) ; Output current buffer. XCT C RET ; Normal return! PUSH P,A ; Error return from out uuo. XOR C,[OUT#] XCT C ; Read file status. TRZ A,74^4 ; Clear error bits. ETR [ASCIZ /Output data error/] XOR C,[#] XCT C JRST POPAJ ; Paper tape stuff, do nothing. TFEED: RET ] ;END IFN DECSW, SUBTTL TNX - Output file Open, Output, Close/Rename IFN TNXSW,[ TFEED: RET ; Again, null out paper-tape hack. ; OINIT - Open Output file. ; P points to first word of args which follow the call: ; 1: , ; is 0 for ascii, 13^9 for bin. ; 2: sixbit // ; 3:
,, ; ; Clobbers A,B,C ; For Tenex, it is necessary to fudge the fileblock consistency slightly; ; $FJFN has in RH the actual JFN used to write to the temporary-name ; file, and in LH the JFN for the final desired filename. Note that if ; the $FEXT is null for main output file, it will be defaulted by TNXODF ; at close time, (to SAV, EXE, or REL) and the ; "final desired" JFN won't actually be used. ; Both JFNS are "active" rather than just a file spec. OINIT: MOVE C,(P) ; Get addr of arg block HLRZ A,2(C) ; Get
, SETOM 2(A) ; and set buffer byte cnt to -1 to mark for init. MOVE F,(C) ; Get , PUSHJ P,GETJFO ; Get output JFN for filblk. JRST OINIT5 ; Lost? OINIT2: HRLZS $FJFN(F) ; Won, move JFN over into LH. ; Aha, successfully grabbed a JFN for desired output filename. ; Now must get another one for the temporary filename... MOVSI A,(GJ%FOU+GJ%NEW) PUSHJ P,TFMAP ; Must set up block again, may have changed due to RDJFNO. MOVE A,1(C) ; Get sixbit/tmpfn2/ PUSHJ P,CV6STR ; Convert to ASCIZ and return BP to string. MOVEM A,GTJBLK+.GJEXT ; Store in long-form call blk. SYSCAL GTJFN,[[GTJBLK] ? [0]][A] ; Repeat the GTJFN call. JRST [ MOVEM A,ERRCOD ; Ugh???? JRST OINIT5] HRRM A,$FJFN(F) ; Good, got it... ; Now have both JFN's packed away, can finally open the ; temporary filename. HRRZ B,A ; Need JFN in RH with LH clear... LDB A,[331100,,F] ; Get CAIN A, MOVSI A,070000 ; If 0, use ASCII (7-bit bytes) TRNE A,-1 MOVSI A,440000 ; If not 0, use WORD (36-bit bytes) TRO A,OF%WR ; Get write access. SYSCAL OPENF,[B ? A][A] ; Open up the temp file (JFN in RH) JRST [ MOVEM A,ERRCOD ? JRST OINIT6] ; damn ; Won, successfully opened output file stuff etc, now wrap up. HRRZ A,$FJFN(F) ; Get JFN used, LDB C,[270400,,F] ; and channel number argument, MOVEM A,JFNCHS(C) ; and store JFN away in channel slot. PUSHJ P,CVFSIX ; Now put right things in $F6 entries. MOVEI A,3 ADDM A,(P) POPJ P, .SCALAR ERRCOD ; Come here when GTJFN fails trying to get a JFN for GTJBLK long ; form argument block. Must print out bad filename. ; OINIT5 should really use names in GTJBLK, and ; OINIT6 should really hack GJFNS call to get names, but for now... OINIT5: SKIPA A,[[ASCIZ /GTJFN failed for /]] OINIT6: MOVEI A,[ASCIZ /OPENF failed for /] PUSHJ P,CRRERR TYPR (A) PUSHJ P,OPNER1 ; Type out filename and error message. PUSHJ P,RDJFNO ; Read new JFN JRST OINIT2 ; try to open it. IOPNER: PUSH P,[CRRERR] ; Do following and add CRLF. OPNER1: PUSHJ P,TYPFB TYPE " Error - " ; Drop thru to TERSTR. TERSTR: MOVE A,ERRCOD HRLI A,.FHSLF SYSCAL ERSTR,[[-1,,ERSTRB] ? A ? [-LERSTR,,]][A ? A ? B] JRST TERST7 ; undefined err #? HALT ; destination bad? TYPR ERSTRB POPJ P, TERST7: TYPE "Unknown error" POPJ P, LERSTR==80. .VECTOR ERSTRB(/5) ; RDJFNO - Hack to get a new JFN by reading from TTY, using recognition. ; RDJFNI - Same but for input. Uses current FB for defaults. ; Stashes JFN away in RH of $FJFN(F). RDJFNO: SKIPA A,[GJ%FOU+GJ%NEW+GJ%CFM] ; For output RDJFNI: MOVSI A,(GJ%OLD+GJ%CFM) ; for input PUSHJ P,TFMAP MOVE A,[.PRIIN,,.PRIOU] ; Use primary JFNs (TTY) for I/O MOVEM A,GTJBLK+.GJSRC PUSH P,R1 PUSH P,R2 PUSH P,R3 CAIA RDJFN2: PUSHJ P,RDJERI ; Come here when get error in GTJFN. MOVEI R1,.PRIIN ; Make sure that CFIBF ; TTY input is reset. HRROI R1,[ASCIZ / Use what filename instead? /] PSOUT MOVEI R1, MOVEI R1,GTJBLK SETZ R2, GTJFN JRST RDJFN2 ; Error, report it. POP P,R3 POP P,R2 HRRM R1,$FJFN(F) POP P,R1 PJRST JFNSTB ; Smash FB with names of the JFN we got, and return. ; RDJERR - Report last error message directly to TTY (primary output). ; Useful when doing quick direct user interaction. RDJERR: TROA R2,-1 ; Here to get last error, whatever it was. RDJERI: MOVE R2,R1 ; Here to use err code in R1. HRLI R2,.FHSLF HRROI R1,ERSTRB MOVSI R3,-LERSTR ERSTR ; Get error string JRST RDJER6 HALT SKIPA R1,[-1,,ERSTRB] RDJER6: HRROI R1,[ASCIZ /Unknown error/] ESOUT ; Output to TTY amid other hackery. POPJ P, ; TNXODF - Hack to get yet another "desired" JFN so that when no ; extension was specified for binary output file, one appropriate to ; the type can be selected. ; Basically do a GTJFN again for binary output filenames, furnishing ; the default extension selected, and use that to replace the one ; already in LH of $FJFN. TNXODF: PUSHJ P,CV6STR ; Convert sixbit word in A to string, get BP in A MOVEI F,OUTFB ; Point at right filblk, MOVEM A,$FEXT(F) ; Store, and now PUSH P,$FJFN(F) ; Save current set of JFNs before PUSHJ P,GETJFO ; getting another one JRST POPAJ ; If lossage, stick to old JFN. POP P,A HRLZS $FJFN(F) ; GETJFO puts JFN into RH, we want it in LH. HRRM A,$FJFN(F) ; now restore previous RH. HLRZS A ; and get old "desired" JFN in position for SYSCAL RLJFN,[A] ; releasing. JFCL POPJ P, ; OCLOSE - Close output file, writing out remainder of buffer and renaming ; from temporary to desired filename. ; JSP A,OCLOSE ; 1: 0 ,,
; 2: ; Clobbers F,C (and obviously A) ; 10x must do CLOSF, not releasing the JFN, and then a RNAMF from temp ; JFN to desired JFN, after which both can be released. The desired and ; used JFNs are in LH and RH respectively of $FJFN in . ; is ignored except to wipe out its JFNCHS entry. OCLOSE: PUSH P,A MOVE C,(A) ; Get ,,
SOS 2(C) ; OBUFO assumes count was SOS'd before each call PUSHJ P,OBUFO ; Write out anything remaining in buffer. LDB C,[270400,,(A)] ; Get channel number MOVE F,1(A) ; Get HRRZ A,$FJFN(F) ; Find JFN being used... CAME A,JFNCHS(C) ; Should be same as JFN for channel. HALT ; Synch error or something. TLO A,(CO%NRJ) ; Say don't release JFN SYSCAL CLOSF,[A] ; Close file... HALT ; ?!?! HRRZS A ; Get back 0,,jfn SETZM JFNCHS(C) ; Indicate "channel" closed... SKIPE FATAL ; If fatal error happened in assembly, JRST OCLOS5 ; don't rename from temp filenames. HLRZ C,$FJFN(F) ; Now see what if anything to rename it to. JUMPE C,OCLOS5 ; If no renaming needed, skip hair. SYSCAL RNAMF,[A ? C] ; Rename file from JFN in A to JFN in C. HALT ; WTF? SYSCAL RLJFN,[C] HALT OCLOS5: SYSCAL RLJFN,[A] HALT SETZM $FJFN(F) POP P,A JRST 2(A) ; OBUFO - Output Buffer and reinitialize. ; C/ 0 ,
; Clobbers no ACs. ; 10X is pretty much like ITS, JFN is kept in JFNCHS table indexed by . OBUFO: PUSH P,A PUSH P,B MOVE A,1(C) ; Get write BP, HRR A,(C) ; and reset it... TLZ A,770000 ; to point at start of buffer, MOVEM A,1(C) ; and store it back, which is OK since we have byte cnt AOSGE 2(C) ; Was buffer marked for initialization (cnt -1)? JRST OBUFO1 ; Yes, don't write anything, just go init rest of it. HLRZ A,(C) ; Get buffer size in wds, MOVNI A,(A) ; make negative, ADD A,2(C) ; and add count of bytes left to get -<# bytes used>. LDB B,[270400,,C] ; Get channel # as index to JFN PUSH P,T SYSCAL SOUT,[JFNCHS(B) ? 1(C) ? A] POP P,T OBUFO1: HLRZ A,(C) ; Get buffer size again, MOVEM A,2(C) ; and reset count with it. POP P,B POP P,A POPJ P, ] ;END IFN TNXSW SUBTTL COMMON Input Routines - Main File Open, EOF handling ; Open main input file for reading (filespec in ISFB) OPNRD: IFN ITSSW, .IOPDL ; Re-initialize IO pdl IFN DECSW\TNXSW, CALL IOPDLC ; Non-ITS systems must simulate. INSIRP SETZM,INFCNT INFCUR INFERR MOVE A,[-TYPDLS-1,,TTYPDL] MOVEM A,ITTYP ; Initialize "tty pdl" PUSHJ P,MACIN1 ; Clobber macro expansion status MOVE A,[ISFB,,INFB] ; Copy ISFB specs to INFB (which will hold BLT A,INFB+L$FBLK-1 ; actual names of current input file) MOVE A,ISFB+$FDEV ; Get device name CAMN A,FSTTY ; TTY? JRST [ MOVE A,[ISFB+$F6FN1,,IFNM1] ; TTY specified, treat special BLT A,IFNM2 ; Clobber .IFNM1, .IFNM2 to specified MOVE A,ISFB+$FVERS MOVEM A,IFVRS TYPECR "Reading from TTY:" MOVEI A,3 ; => input from tty, don't quit on cr JRST OPNRT2] MOVEI F,INFB ; Point things at INFB. PUSHJ P,OPNRD1 ; Try opening file JRST [ PUSHJ P,IOPNER ; Open lost, type out message POPJ P,] ; Read new command (this may screw on pass2?) MOVEM A,INFERR ; Err msg in main file shouldn't type names. MOVEI A,0 ; => input from file IFN TNXSW,[ MOVE T,INFB+$FJFN ; Copy actual jfn to avoid re-GTJFN MOVEM T,ISFB+$FJFN ] OPNRT2: MOVE T,[IFNM1,,RFNAM1] BLT T,RFVERS ; Set up .FNAM1, .FNAM2 SETOM NEDCRL AOS (P) ; Won, skip on return. JRST RCHSET ; Set up to read from file or tty. (arg in A) ; Common stuff for OPNRD1 in all (DEC/ITS/TENEX) versions. OPNRD3: HRRZM A,UTIBED ; Say buffer empty, MOVSI A,EOFCH_13 MOVEM A,@UTIBED ; Cause immediate reload. OPNRD4: BLTM 2,$F6FN1(F),IFNM1 ; Set up .IFNM1, .IFNM2 from filblk F points at MOVE A,$FVERS(F) MOVEM A,IFVRS AOS A,INFCNT ; Assign this file a number. MOVEM A,INFCUR ; OPNRD expects this left in A. JRST POPJ1 ; EOF while trying to read character RPAEOF: PUSH P,B ; Save B RPAEO1: MOVE B,ITTYP ; Get pdl pointer PUSHJ P,BPOPJ ; Call pop routine (maybe NED's out) JRST RCHTRB ; Return to get character ; EOF from main file NEDCHK: TRNE FF,FRCMND ; ^C read in command, :KILL self. JRST TSRETN SKIPN RCHMOD AOSE NEDCRL JRST NEDCH1 ; Invent one crlf after end of main file. MOVE B,[440700,,[.BYTE 7 ? ^M ? ^J ? EOFCH]] MOVEM B,UREDP HRRZM B,UTIBED IFN PMAPSW,[ HRLI B,170700 ; Make BP pointing at last (3rd) char MOVEM B,UTIBPE ; Set EOF BP properly. ] RET NEDCH1: IFN A1PSW,[ PUSHJ P,OUTCHK MOVSI A,-LNEDT XCT NEDT(A) ; Skips if NED condition to be complained about AOBJN A,.-1 JUMPGE A,GO8 ] ETF [ASCIZ /No END statement/] .SCALAR NEDCRL ; -1 => haven't yet supplied a CRLF at EOF of main file. IFN A1PSW,[ ; Holler "NED" if any of the following: NEDT: SKIPL PRGC ; No end statements have been encountered SKIPGE OUTC ; Output has occured not matched by an end statement SKIPGE OUTN1 ; Output has occured other than in 1pass mode TRNN FF,FRPSS2 ; Currently in pass 2 LNEDT==.-NEDT ; Length of table ] SUBTTL ITS - Input file Open, buffer input IFN ITSSW,[ ; Try .OPENing input file pointed to by F. Skips if successful. ; Sets filenames to actual names. OPNRD1: SYSCAL OPEN,[[.BAI,,UTYIC] $F6DEV(F) ? $F6FN1(F) ? $F6EXT(F) ? $F6DIR(F)] JRST [ .STATUS UTYIC,IFSTS ; Lost, save status now before possible POPJ P,] ; .IOPOP, and make failure return. SYSCAL RFNAME,[%CLIMM,,UTYIC ; Now find true filenames. MOVEM A MOVEM C ; But need to check FN1, FN2 so MOVEM D ; put them in ACs instead. MOVEM $F6DIR(F)] .LOSE %LSFIL CAMN A,[SIXBIT/DSK/] MOVE A,V.SITE ; Use machine name instead of DSK. MOVEM A,$F6DEV(F) CAIE C, ; If FN1 meaningless for device, skip to use MOVEM C,$F6FN1(F) ; spec'd FN1 anyway, but else store actual FN1. CAIE D, MOVEM D,$F6FN2(F) ; Ditto for FN2. MOVE D,[440600,,$F6FN2(F)] SETZ A, OPNRD7: TLNN D,770000 JRST OPNRD6 ILDB C,D ; Calculate version number as number from fn2. CAIL C,'0 ; Ignore non-digits. CAILE C,'9 JRST OPNRD7 IMULI A,10. ADDI A,-'0(C) JRST OPNRD7 OPNRD6: SKIPN A ; No digits in FN2 => use -1 as version. SETO A, MOVEM A,$FVERS(F) MOVE A,IUREDP ; Set up reading ptr, MOVEM A,UREDP JRST OPNRD3 ; Set up ^C after buffer, infcur, etc. ; EOFCH encountered on read, reload and jump back for next char INCHR3: HRRZ CH1,UREDP ; Get byte pointer CAME CH1,UTIBED ; End of block? RET ; No, ^C in file. MOVE A,IUREDP MOVEM A,UREDP MOVE A,[-UTIBFL,,UTIBUF] .IOT UTYIC,A ; Read in block ANDI A,-1 CAIN A,UTIBUF ; If the iot didn't give us anything, we are at EOF. JRST RPAEOF HRRZM A,UTIBED ; Store RH (updated pointer) for EOF check at INCHR3 MOVSI A,EOFCH_<18.-7> MOVEM A,@UTIBED ; Store a ^C after the data we read, so at EOB we come to INCHR3. JRST RCHTRA ; Now try next char ] ;END IFN ITSSW SUBTTL DEC - Input file Open, buffer input IFN DECSW,[ OPNRD1: MOVEI C,UTIHDR ; Open the input file w/ names in dnam ... snam. SETZ A, ; Mode ascii. MOVEI D,UTIBUF MOVE TT,UTICHN ; Get channel num. to use. LSH TT,27 ; Put in ac field. IOR TT,[OPEN A] MOVE B,$F6DEV(F) XCT TT ; Open channel,a RET CALL BUFINI ; Initialize the input buffers and header. MOVE D,$F6DIR(F) MOVE A,$F6FNM(F) HLLZ B,$F6EXT(F) TLC TT,(OPEN#LOOKUP) XCT TT ; Lookup channel,a RET ; Failed. IFE SAILSW,[ MOVE A,$F6DEV(F) DEVNAM A, ; Get real name of device. CAIA MOVEM A,$F6DEV(F) ] MOVE A,UREDP JRST OPNRD3 ; Reload buffer, DEC style. INCHR3: HRRZ CH1,UREDP ; Is this ^C at end of buffer? CAME CH1,UTIBED RET ; No, ^C in file. PUSH P,B MOVE A,UTICHN LSH A,27 ; Channel num. in ac fld. TLO A,(IN) XCT A ; Get next bufferfull. CAIA ; Succeed. JRST INCHR4 ; Error. INCHR5: MOVE A,UTICNT ADDI A,9 IDIVI A,5 ADD A,UREDP ; -> 1st wd not read into. HRRZM A,UTIBED HRRZ A,UREDP AOS A MOVEI B,1 ; Scan the file and replace all line numbers with nulls. INCHR6: CAMN A,UTIBED JRST INCHR7 TDNE B,(A) MOVEM B,(A) AOJA A,INCHR6 INCHR7: MOVSI B,EOFCH_13 MOVEM B,(A) ; Put EOF char after buffer, in extra word. JRST RCHTRB ; Retry RCH. INCHR4: XOR A,[#IN] XCT A TRZE B,74^4 ETR [ASCIZ /Input data error/] XOR A,[#] XCT A ; Clear error bits in status. TRNN B,2^4 JRST INCHR5 JRST RPAEO1 ; EOF. ; BUFINI - Create DEC-style buffer ring, with 1 extra word following ; each buffer... ; A/ ; B/ ; C/
; D/ ; Note that this extra-word crock is necessary just so it can be filled ; with ^C's to stop read loop and switch to next buffer. BUFINI: MOVEI AA,A IFE SAILSW,DEVSIZ AA, SKIPA AA,[DECBFL+1] ; Default buffer size is that for dsk. AOJLE AA,.-1 ; Get size including extra wd. MOVEI T,1(D) ; Addr of wd 2 of 1st buffer. HRLI AA,T ; @AA is addr of 2nd wd of next buffer. SUBI D,(AA) ; Facilitate test for end of buffer space. HRLI T,400000 MOVEM T,(C) ; Header -> a buffer, sign set. HRRM T,1(C) ; Make rh of bp -> buffer 1st wd. MOVSI T,440000 ; Set up p-field of b.p. IORM T,1(C) HRRZ T,1(C) AOS 1(C) HRLI T,-3(AA) ; Data-area-size +1,,addr-of-2nd-wd BUFIN1: CAIGE D,-UTIBFL(T) ; Room for another after this buffer? JRST BUFIN2 ; No, wrap up. MOVEM T,@AA ; Yes, make next buffer -> this one, HRRI T,@AA ; Point to next one. JRST BUFIN1 BUFIN2: ADDI D,1(AA) ; -> 2nd wd of 1st buffer. MOVEM T,(D) ; 1st buffer -> last, making ring. RET ] ;END IFN DECSW, SUBTTL TNX - Input file Open, buffer input IFN TNXSW,[ ; OPNRD1 - Open File for Reading. Old stuff assumed fnm in DNAM ; using UTYIC channel, but new should furnish arguments: ; F/ to open ; Essentially just GTJFN and OPENF like OINIT does, with same ; sort of error handling, except that when reading from cmd line ; as opposed to .INSRT, just go back to get completely new command. ; (perhaps if typein is just CRLF, go to special TNX style cmd input?) OPNRD1: CAIN F,INFB ; Horrible kludge necessary because MIDAS main ; level doesn't bother to explicitly close main ; input file when pass 1 is done, and TNX barfs if ; you try to re-open a JFN... sigh. JRST [ SKIPN $FJFN(F) ; Main file. Already opened it? JRST .+1 ; nope, get JFN & open normally. IFE PMAPSW,[ ; Already open. If not mapping, reset read ptr. SYSCAL SFPTR,[$FJFN(F) ? [0]][ERRCOD] POPJ P,] JRST OPNRD2] ; and avoid attempt to re-open the JFN. SKIPN $FJFN(F) JRST [ PUSHJ P,GETJFI ; No JFN, get one for input. POPJ P, ; Could fail. JRST .+1] PUSH P,T ; Read access, full word input. SYSCAL OPENF,[$FJFN(F) ? [440000,,OF%RD]][ERRCOD] JRST [POP P,T ? POPJ P,] ; Failure POP P,T OPNRD2: HRRZ A,$FJFN(F) MOVEM A,JFNCHS+UTYIC ; Indicate "channel" open with this JFN. PUSHJ P,JFNSTB ; Get actual names/version #. PUSHJ P,CVFSIX ; Put right stuff in $F6 entries. MOVE A,IUREDP ; Opened, set up buffer. MOVEM A,UREDP ; Initialize BP into buffer. IFE PMAPSW, JRST OPNRD3 IFN PMAPSW, JRST OPNR50 ; for PMAP hacking, lots of stuff to do. ; Get a JFN for current FILBLK (in F) and stick it into $FJFN(F). ; A should hold flags in LH to use in 1st wd of block. ; GETJFI - sets usual flags for input ; GETJFO - sets " " output ; GETJFN - takes whatever A holds. GETJFO: SKIPA A,[GJ%FOU+GJ%NEW] ; If hacking output, ask for new version. GETJFI: MOVSI A,(GJ%OLD) ; If hacking input, file must exist. GETJFN: PUSHJ P,TFMAP ; Stick filblk stuff into GTJFN scratch block. PUSH P,R1 PUSH P,R2 MOVEI R1,GTJBLK SETZ R2, GTJFN JRST [ MOVEM R1,ERRCOD ; failure, save error code. JRST GETJF5] HRRM R1,$FJFN(F) ; Win, save JFN. AOS -2(P) GETJF5: POP P,R2 ; Can't return in ACs cuz don't know what R1 etc are, POP P,R1 ; and might clobber them here. POPJ P, ; TFMAP - Map Tenex filenames from filblk pointed to by F into ; standard scratch block for long-form GTJFN. ; A/ ,,0 ; flags will go into LH of .GJGEN. ; Clobbers only A. TFMAP: HRR A,$FVERS(F) ; Put version # in RH SKIPE $FTEMP(F) ; If asking for temp file, TLO A,(GJ%TMP) ; set appropriate flag. MOVEM A,GTJBLK+.GJGEN IRP FROM,,[$FDEV,$FDIR,$FNAME,$FTYPE,$FPROT,$FACCT,$FJFN]TO,,[.GJDEV,.GJDIR,.GJNAM,.GJEXT,.GJPRO,.GJACT,.GJJFN] MOVE A,FROM(F) MOVEM A,GTJBLK+TO TERMIN MOVE A,[.NULIO,,.NULIO] MOVEM A,GTJBLK+.GJSRC ; Don't hack I/O in gtjfn. POPJ P, .VECTOR GTJBLK(10.) ; Need exactly this many wds for non-extended long call IFE PMAPSW,[ ; EOFCH seen in input, check it here. INCHR3: HRRZ CH1,UREDP ; Get byte pointer CAME CH1,UTIBED ; End of block? RET ; No, ^C in file. MOVE A,IUREDP MOVEM A,UREDP PUSH P,T SYSCAL SIN,[JFNCHS+UTYIC ? [444400,,UTIBUF] ? [-UTIBFL]][A ? A ? A] POP P,T ADDI A,UTIBUF+UTIBFL ; Get UTIBUF + <# bytes stored> CAIG A,UTIBUF ; If the sin didn't give us anything, we are at eof. JRST RPAEOF HRRZM A,UTIBED ; Store rh (updated pointer) for eof check at inchr3 MOVSI A,EOFCH_<18.-7> MOVEM A,@UTIBED ; Store a ^c after the data we read JRST RCHTRA ; Now try next character ] ; IFE PMAPSW IFN PMAPSW,[ ; New stuff for PMAP'ing input etc. VBLK IFNDEF NIBFPS,NIBFPS==10 ; # of pages per buffer PGBFL==NIBFPS*1000 ; Length of a buffer in wds. IFNDEF 1STBFP,1STBFP==500 ; # of first page to start buffers at. INBFPG: 1STBFP ; # of 1st buffer page (in our address space) INFPAG: 0 ; # of page in file corresponding to 1st page in buffer. INPGCT: 0 ; -# times to refill buffer with new pages. INLPGS: 0 ; # pages to slurp on last refill (instead of NIBFPS) UTIBPE: 0 ; BP to last byte of data in buffer (holding ^C) UTIBPL: 0 ; BP to last byte position in buffer area (constant) UTIBPX: 0 ; BP to last byte of data when last pages have been mapped. INLCHR: 0 ; Place to save char that ^C replaces. If -1, no char. ;SOSSW: 0 ; non-Z if hacking SOS line-number type file. FBBYV: 0 ; GTFDB dumps cruft in these two locs. FBSIZ: 0 ; e.g. this gets size of file in bytes. PBLK ; Wrap up open of an input file, by initializing all the cruft ; above. OPNR50: SYSCAL GTFDB,[$FJFN(F) ? [2,,.FBBYV] ? MOVEI FBBYV] LDB C,[300600,,FBBYV] ; Get byte size of file CAIN C, MOVEI C,36. ; If 0 use 36-bit bytes (full wds) MOVEI A,36. IDIVI A,(C) ; Get bytes per wd, ignore remainder. MOVE B,FBSIZ ; Now, with # bytes in file, EXCH A,B IDIVI A,(B) ; find <# in fil>/<# per wd> = # wds in file CAIE B, ; Also hack ADDI A,1 ; rounding up (gasp, wheeze, finally done.) IDIVI A,PGBFL ; Now get # times buffer will need slurping... CAIE B, ADDI A,1 ; Also round up. B has # "live" words in last slurp. MOVNM A,INPGCT ; Store -# slurps. MOVEI A,1777(B) LSH A,-9. ; Find # pages last slurp really needs. MOVEM A,INLPGS ; and store away. HRLI B,010700 MOVEM B,UTIBPX ; Store relative BP to last ch (when last pages mapped) HRRI B,PGBFL-1 ; And relative BP to last char in whole buffer MOVEM B,UTIBPL MOVE A,INBFPG ; Find page # buffer starts at in core, LSH A,9. ; Get address, and ADDM A,UTIBPX ; add into the BP's to make them absolute. ADDM A,UTIBPL HRLI A,010700 ; also get initial read pointer from that. SUBI A,1 ; MUST be "canonical form", so that SEMIC hackery MOVEM A,IUREDP ; will work with weird way INCHR3 returns here. MOVNI A,NIBFPS ; Use this as initial file page #, so the ADDB in MOVEM A,INFPAG ; INCHR3 will do right thing to it. MOVE A,[440700,,[EOFCH_35]] MOVEM A,UREDP ; set up things so first RCH will instantly cause reload. ILDB B,A MOVEM A,UTIBPE SETOM INLCHR ; Mustn't forget that we don't have a stored char yet. JRST OPNRD4 ; Finally done with PMAP init stuff. ; Come here when hit ^C INCHR3: MOVE CH1,UREDP ; Get current read ptr CAME CH1,UTIBPE ; At end of buffer? POPJ P, ; Nope, ^C in file, actual input. AOSLE CH1,INPGCT ; Aha, end of buffer. Bump times refilled... JRST [ SKIPGE A,INLCHR ; and if no more refills, see if last char left JRST RPAEOF ; No? All done, true EOF. SETOM INLCHR ; Almost, one last char. MOVE CH1,UREDP ; Must bump ptr back one char, so next read ADD CH1,[070000,,] ; will also stop. CAIG CH1, SUB CH1,[430000,,1] MOVEM CH1,UREDP JRST INCHR7] ; Return char in A. MOVE A,IUREDP MOVEM A,UREDP IFN A-1,PUSH P,R1 IFN A-2,PUSH P,R2 IFN A-3,PUSH P,R3 MOVEI R1,NIBFPS ; Get # of input buffer pages ADDB R1,INFPAG ; and find current page in file to get HRL R1,$FJFN+INFB ; current input file's JFN MOVE R2,INBFPG ; and usual pointer to destination buffer page HRLI R2,.FHSLF ; Why the fuck doesn't 10X default this?!?! MOVEI R3,NIBFPS ; Set # pages to slurp up CAIN CH1, ; But if this is last slurp, MOVE R3,INLPGS ; use pre-calculated # to avoid non-ex pages. TLO R3,(PM%CNT+PM%RD+PM%CPY) ; Read access, copy-on-write. INCH50: PMAP ; Gobble gobble TLNN FF,FL20X ; If on 20X, that's all. JRST [ HRRI R3,-1(R3) ; Else, on 10X, must iterate manually. TRNE R3,400000 ; See if became "negative". JRST .+1 ; Yep, done with manual iteration. ADDI R2,1 ; Nope, bump page #'s. AOJA R1,INCH50] IFN A-3,POP P,R3 IFN A-2,POP P,R2 IFN A-1,POP P,R1 CAIE CH1, ; Was this the last slurp? SKIPA CH1,UTIBPL ; no, use BP to Last char at end of buffer. MOVE CH1,UTIBPX ; yes, need BP to last char in last page. IFN 0,[ SKIPE SOSSW ; If hacking line number lossage, JRST [ MOVE A,(CH1) ; must beware of getting wiped, so have to TRNE A,1 ; check here, and if depositing EOFCH in #, HRLI CH1,350700 ; then move the EOFCH to beg of word! JRST .+1] ] LDB A,CH1 ; Replace last char of buffer's data MOVEI CH2,EOFCH DPB CH2,CH1 ; with the EOF char. MOVEM CH1,UTIBPE ; Remember ptr to end of data, EXCH A,INLCHR ; and save char for then, returning whatever JUMPL A,RCHTRA ; was the last char of last bufferfull. ; (may be -1, in which case RCHTRA tries again) ; Jump here to return a new char in A, something like ; RCHTRA without all the fuss. INCHR7: POP P,CH1 ; Get return addr ANDI CH1,-1 CAIE CH1,RREOF+1 JRST -2(CH1) ; Note -2 not -3 as in RCHTRA! JRST (CH1) ; Special hack since -2 loses for RREOF. ; Perhaps someday it will win. ] ; IFN PMAPSW ] ;END IFN TNXSW ifn 0,[ ; turn off but keep around for a while. SUBTTL old .INSRT Processing ; .INSRT ; Insert file here ; TTY: => ok, reads line at a time, rubout allowed within line ; Pushes macro expansion, other .INSRT's ; In filedescription, ^R => reset file name counter [?!? - KLH] ; If device is "@:", always ask for translation. A.INSR: NOVAL MOVE A,[ISFB,,FB] ; Default names are those of spec'd input file BLT A,FB+L$FBLK-1 ; Zap them into scratch filblk. MOVEI F,FB ; And point at it. MOVE A,FSDSK MOVE B,FSTTY ; Compare "TTY" with CAMN B,$FDEV(F) ; device name, and if identical, MOVEM A,$FDEV(F) ; default to DSK. IFE ITSSW,MOVE A,FSMID ; Always set default extension to "MID" or ">" IFN ITSSW,MOVE A,FSGRTN MOVEM A,$FEXT(F) TLO FF,FLUNRD A.IN1: PUSHJ P,RFD ; Read file description MOVE A,$FDEV(F) ; Get specified device name CAME A,FSATSN ; Atsign? PUSHJ P,A.ITRY ; No, try opening file ; If return, open failed. MOVE A,$F6DEV(F) AOJE A,A.INT1 ; Already trying to set up table entry SKIPA F,[MAXIND,,TBLOFS] ; Atsign, or fnf, search table A.IN2: SUBI F,-L$FBLK ; Loop point searching table, increment to next entry, count down LH CAMN F,INDDP ; Compare with pointer to top of table JRST A.IN3 ; Agree => this file not in table ; MOVEI A,-TBLOFS(F) ; Get index relative to table base. ; MIDAS complains "illegal use of relocation" when try to use above addr, so must use next 2 instructions instead - barf barf MOVEI A,(F) SUBI A,TBLOFS MOVSI B,-L$FBLK ; And index into FB. MOVE T,TBLSFS(A) ; Get specification name this entry A.IN25: CAMN T,FB(B) ; Compare with that just specified AOBJN B,[AOJA A,.-2] ; Check all names this entry IFE TNXSW, JUMPL B,A.IN2 IFN TNXSW,[JUMPL B,[ MOVEI C,(B) CAIN C,$FJFN ; One item of entry didn7t match, was it JFN? JRST A.IN25 ; Yes, ignore it and continue. JRST A.IN2] ; Sigh, was something else, entry doesn't match. ] ; File is in table MOVSI A,(F) ; Move description from TBLOFS to FB. HRRI A,FB BLT A,FB+L$FBLK-1 IFN TNXSW, SETZM FB+$FJFN ; Since re-opening, must zap previous JFN. PUSHJ P,A.ITRY ; Try opening file ; If return, open failed. MOVSI A,TBLSFS-TBLOFS(F) ; Set up LH(BLT pointer), HRRI A,FB BLT A,FB+L$FBLK-1 ; Unmap to original names(TBLSFS to FB) PUSHJ P,TYPFB ; Type out specified names TYPE " -> " ; Type out pointer MOVSI A,(F) ; Copy translation (TBLOFS entry) back to FB. HRRI A,FB BLT A,FB+L$FBLK-1 SETOM $F6DEV(F) ; "half-kill" entry in TBLOFS A.INT1: PUSH P,F MOVEI F,FB PUSHJ P,IOPNER ; Open lost, type out cruft POP P,F TYPE "Use what filename instead? " A.INT2: PUSHJ P,GTYIP ; Prepare to read one line from tty JRST A.IN1 ; Try again with what he types in ; File not in table, try to add a translation for it. A.IN3: TLNN F,-1 ; More room for another entry in table? ETF [ASCIZ /Too many @: files/] MOVEI A,TBLSFS-TBLOFS(F) ; Copy FB into TBLSFS (specified name) HRLI A,FB BLT A,TBLSFS-TBLOFS+L$FBLK-1(F) SETOM $F6DEV(F) ; Document fact that entry has only key, not translation MOVNI A,-L$FBLK ADDM A,INDDP ; Update pointer into table MOVE A,FB+$FDEV ; Get specified device name CAME A,FSATSN ; Atsign? JRST A.INT1 ; No, type out garbage and try again, reading from tty MOVE A,ISFB+$FDEV ; Yes, clobber from input device name MOVEM A,FB+$FDEV JRST A.INT2 ;TRY OPENING INPUT FILE FOR .INSRT, RETURN IF UNSUCCESSFUL A.ITRY: MOVE A,FB+$FDEV ; Get specified device name CAMN A,FSTTY ; TTY? JRST A.ITRT ; Yes, treat special TLO FF,FLUNRD PUSHJ P,IPUSH ; Save current status PUSH P,F ; save what F points at MOVEI F,FB PUSHJ P,OPNRD1 JRST [POP P,F ? JRST IPOPL] ; Lose, pop and return POP P,F MOVE B,[FB,,INFB] ; Kludge for time being - if win, BLT B,INFB+L$FBLK-1 ; Copy all stuff into INFB. IFN ITSSW,CALL SETWH2 MOVE B,ITTYP MOVEI A,-2-TYPDEL(B) ; HRLI A,IFNM1 BLT A,-TYPDEL(B) ; Introduce hysteresis so .INSRT'ing file can reference .IFNM1, .IFNM2 IFN CREFSW,[ SKIPE CRFONP ; If creffing, output push-file block. PUSHJ P,CRFPSH ; (pop-file block output at ipop) ] A.ITR2: MOVE A,$F6DEV(F) ; Push successful, now check to see if table entry should be finished AOJN A,ASSEM1 MOVEI A,(F) ; Move FB into TBLOFS as translation entry. HRLI A,FB BLT A,L$FBLK-1(F) JRST ASSEM1 ; Now assemble from file (ASSEM1 clobbers pdl) ; .INSRT TTY: A.ITRT: PUSHJ P,GTYIPA ; Read from tty, don't quit until .INEOF JRST A.ITR2 ; Fall back in (doesn't touch .IFNM1, .IFNM2) ] ; end IFN 0 SUBTTL .INSRT Processing ; .INSRT ; Insert file here ; TTY: => ok, reads line at a time, rubout allowed within line ; Pushes macro expansion, other .INSRT's ; If device is "@:", always ask for translation. A.INSR: NOVAL ; First set up defaults for parsing filename. BLTM L$FBLK,ISFB,FB ; Default names are those of spec'd input file, MOVEI F,FB ; stuffed into scratch FB. MOVE A,FSDSK MOVE B,FSTTY ; Compare "TTY" with CAMN B,$FDEV(F) ; device name, and if identical, MOVEM A,$FDEV(F) ; default to DSK. IFE ITSSW,MOVE A,FSMID ; Always set default extension to "MID" or ">" IFN ITSSW,MOVE A,FSGRTN MOVEM A,$FEXT(F) TLO FF,FLUNRD PUSHJ P,RFD ; Read file description from current input. MOVE A,$FDEV(F) ; Get specified device name CAMN A,FSATSN ; Atsign? JRST A.IN50 ; If so, check out translation right away. A.IN2: CAMN A,FSTTY ; TTY? Must handle specially. JRST [ PUSHJ P,GTYIPA ; Set up to read until .INEOF or EOF char. JRST ASSEM1] ; And don't do anything to .IFNM1/2, etc. PUSHJ P,IPUSH ; File, push the world. PUSHJ P,OPNRD1 ; Try opening file. JRST [ PUSHJ P,IPOPL ; Sigh, failed, pop world back and go JRST A.IN50] ; try translation entries or TTY input. ; Always jumps back to A.IN2. ; Come here when input file successfully opened. Clean up etc. BLTM L$FBLK,(F),INFB ; Move current filespec to INFB, IFN ITSSW,CALL SETWH2 MOVE B,ITTYP BLTM 3,IFNM1,-2-TYPDEL(B) ; Copy new .IFNM1, .IFNM2 onto stack, ; to clobber .IFNM1/2 for previous file, so ; that .IFNM1/2 etc refers to last file .INSRT'd by ; current file (or current file if none .INSRT'd yet) IFN CREFSW,[ SKIPE CRFONP ; If creffing, output a push-file block. PUSHJ P,CRFPSH ; (pop-file block is output at IPOP) ] JRST ASSEM1 ; and jump off to smash things to toplevel. ; Come here when open attempt fails or @: device specified. A.IN50: CAIE F,FB ; Tried translations yet? JRST A.IN60 ; Yes, skip table hacking and go get fnm from TTY. ; First open attempt, so OK to search translation table. SKIPA D,[MAXIND,,TBLOFS] ; Load up aobjn-style index to transl table A.IN52: SUBI D,-L$FBLK ; Loop point for searching table - increment to next entry, count down LH CAMN D,INDDP ; Compare with pointer to top of table JRST A.IN60 ; Agree => this file not in table, get from TTY. MOVEI A,(D) ; Get scratch index into tables, HRLI A,-L$FBLK ; making AOBJN of it, MOVEI B,(F) ; and get index into current FB. A.IN54: MOVE C,TBLSFS-TBLOFS(A) ; Get a specification name for this entry IFN TNXSW,CAIE B,$FJFN(F) ; (ignoring the JFN item, for TENEX) CAMN C,(B) ; Compare name with that of failed filblk. AOBJN A,[AOJA B,A.IN54] ; Check all names this entry JUMPL A,A.IN52 ; If not found, try next entry. ; File is in table, try opening it using TBLOFS description. MOVE F,D ; Replace old F by ptr to winning TBLOFS entry. IFN TNXSW, SETZM $FJFN(F) ; Since re-opening, must zap any previous JFN. JRST A.IN2 ; Jump off to try opening. ; Come here when open failed and no matching transl entry. ; Must set up to gobble down a translation from TTY... A.IN60: TYPE "Error in .INSRT; " CAIE F,FB ; Were we trying to open a translated entry? JRST [ PUSHJ P,TYPFB ; Yes, so print out appropriate info TYPE " -> " ; to show translated stuff. JRST A.IN70] ; First time, no translation entry exists, make one. MOVE A,INDDP ; Get current pointer to top of tables TLNN A,-1 ; Room for more? JRST A.IN70 ; Nope, can't remember transl, but get right fnm anyway. MOVE F,A ; Yep, use it as pointer to table entry to use. SUBI A,-L$FBLK ; and get new table-top pointer with clever MOVEM A,INDDP ; SOS of LH and ADDI to RH. BLTM L$FBLK,FB,(F) ; Move FB contents to both TBLOFS, BLTM L$FBLK,FB,TBLSFS-TBLOFS(F) ; and TBLSFS. A.IN70: ; Print out filename F points to, & err msg. IFN TNXSW,[ PUSHJ P,OPNER1 PUSHJ P,RDJFNI ; On 10X, get new filename this way. ] IFN ITSSW\DECSW,[ ; Elsewhere do it painful way. PUSHJ P,IOPNER TYPE "Use what filename instead? " PUSHJ P,GTYIP ; Setup to read 1 line from TTY, PUSHJ P,RFD ; and do it, parsing filename. ] JRST A.IN2 ; now go try opening it. SUBTTL Misc. .INSRT-related things ; .INEOF - EOF pseudo A.IEF2: PUSHJ P,PMACP ; Loop point, pop entry off macro pdl A.INEO: TLNE FF,FLMAC ; Inputting from macro? JRST A.IEF2 ; Yes, pop it off PUSH P,CMACCR ; Back to inputting from file or tty, cause return to maccr MOVE B,ITTYP ; Get pdl pointer POPJ B, ; Return to pop routine ; Call from ERRH; type input file's names if changed since last err msg. ERRTFL: MOVE C,INFCUR EXCH C,INFERR ; Say last error msg in this file. CAMN C,INFERR ; If prev. msg was in other file, POPJ P, PUSH P,F MOVEI F,INFB ; Point to current input file, PUSHJ P,TYPFB ; and type out its filename. POP P,F PJRST CRRERR SUBTTL COMMON IO PDL routines for input. (.INSRT support) ;IO PDL ROUTINES FOR INPUT FILE ; Push the input file IPUSH: AOSN CMEOF ; Want to pop out of tty? (^C typed in) CALL POPTT ; Yes, do now before forget. IFE PMAPSW,[ MOVE D,UREDP ; Get input byte pointer IFN ITSSW\TNXSW,[ IFN ITSSW, .IOPUS UTYIC, IFN TNXSW, MOVEI A,UTYIC ? PUSHJ P,$IOPUSH TLNN D,760000 ; At end of word? ADD D,[430000,,1] ; Yes, make it point to beginning of next word MOVEM D,UREDP MOVNI A,-2(D) ADD A,UTIBED ; Get # wds we'll need in MACTAB. HLR D,UTIBED ; Remember whether EOF on last .IOT. HRRZS UTIBED ; Now clear out left half for following ] IFN DECSW,[ AOS A,UTICHN ; Do ".IOPUSH" - use next channel. LSH A,27 ADD A,[WAIT-<0 1,>] ; Construct a WAIT uuo for the current input channel. MOVE C,RCHMOD ; We mustn't copy the buffers while I/O is going on. CAMN A,[WAIT UTYIC,] ; But: if we are currently in the top-level input file CAIE C,3 ; And it is device TTY:, this channel was never opened. XCT A ; Don't move buffers while io going on! MOVEI A,UTIBFL+2 ; Assume must save all buffer space. ] PUSH P,A ADD A,FREPTB ANDI A,-1 PUSH P,A CAML A,MACTND ; No room in MACTAB => gc it. CALL GCA1 REST A CAML A,MACTND ; Did the GC win? PUSHJ P,GCCORQ ; NO!! Try to win somehow MOVEI A,370 CALL PUTREL ; Indicate start of saved buffer. REST A AOS B,FREPTB SUBI A,1 MOVE C,ITTYP ; Get addr of tty pdl wd that'll point to saved buffer. ADDI C,1 HRRZM C,(B) ; Store in rh of 1st wd, MOVEI C,(B) ; Remember addr of saved buffer to push on ttypdl. HRLM A,(B) ; Put length in lh. AOS B IFN ITSSW\TNXSW,HRL B,UREDP ; LH <- addr of 1st wd to save. IFN DECSW,HRLI B,UTIBUF ADDI A,-2(B) ; Addr of last wd to blt into. BLT B,(A) HRLI A,041000 MOVEM A,FREPTB ; Make free bp -> last byte just used. SUB A,MACTAD ANDI A,-1 LSH A,2 ADDI A,4 ; Get char addr of next free byte. MOVEM A,FREEPT ] IFN PMAPSW, CALL IOBPUS MOVE B,ITTYP ; Get local version of iopdl IPSHP: IFE PMAPSW, PUSH B,C ; Push -> saved buffer (GC will relocate) IFN DECSW,PUSH B,UTIBED ? PUSH B,UTIHDR REPEAT L$FBLK, PUSH B,INFB+.RPCNT ; Save names of input file. PUSH B,INFCUR ; Save number of input file. IFE PMAPSW, PUSH B,D ; Lh=lh(old uredp), rh=lh(old utibed) (or just UREDP) IFN PMAPSW, INSIRP PUSH B,[INFPAG INPGCT INLPGS UTIBPE UTIBPL UTIBPX INLCHR UREDP IUREDP ] ; Following three must be last pushed INSIRP PUSH B,[IFNM1 IFNM2 IFVRS] ; Clobbered on pdl if .open successful INPDEL==.-IPSHP ; Length of each entry on pdl MOVE A,FREEPT ; W must use same gc convention as putrel; CAML A,MACHI ; Namely, gc after using up the last byte. CALL GCA1 MOVEI A,0 ; => input from file MOVEM B,ITTYP ; Store back updated pointer JSP B,PUSHTT ; Save stuff, address modify and return ; Pop into the input file IPOP: IFN CREFSW,[ MOVEI A,2 ; If creffing, output pop-file block. SKIPE CRFONP PUSHJ P,CRFOUT] IPOPL: PUSHJ P,POPTT ; Come here if .INSRT's open failed. PUSH P,C MOVE B,ITTYP ; Get pointer INSIRP POP B,[IFVRS IFNM2 IFNM1] ; Pop stuff IFE PMAPSW, POP B,A ; Pop off UREDP (or halves thereof) IFN PMAPSW, INSIRP POP B,[ IUREDP UREDP INLCHR UTIBPX UTIBPL UTIBPE INLPGS INPGCT INFPAG] POP B,INFCUR REPEAT L$FBLK,POP B,INFB+L$FBLK-1-.RPCNT IFN DECSW,[ POP B,C PUSH P,C ; Old UTIHDR POP B,UTIBED ] IFE PMAPSW, POP B,C MOVEM B,ITTYP ; Save updated pdl pointer. IFE PMAPSW,[ HLRZ B,(C) ; Get length of saved buffer, IFN ITSSW\TNXSW,[ PUSH P,A IFN ITSSW, CALL SETWH2 ? .IOPOP UTYIC, IFN TNXSW, MOVEI A,UTYIC ? CALL $IOPOP REST A MOVEI AA,UTIBUF-1(B) ; Get addr of 1st wd won't blt into in utibuf, HRLI AA,(A) ; Get saved lh of utibed, MOVEM AA,UTIBED HRRI A,UTIBUF ; Make A -> 1st wd in buffer, ] IFN DECSW,[ MOVE AA,UTICHN LSH AA,27 IOR AA,[RELEAS] XCT AA ; This code equivalent to .IOPOP. SOS UTICHN REST UTIHDR ] MOVEM A,UREDP MOVSI A,EOFCH_13 MOVEM A,@UTIBED ; Put EOF char after buffer. MOVSI A,1(C) ; Get addr of 1st data wd of saved buffer, HRRI A,UTIBUF CAIE B,1 BLT A,UTIBUF-2(B) HLLZS (C) ; Tell GC to reclaim saved buffer. ] ;IFE PMAPSW IFN PMAPSW, CALL IOBPOP POPCJ: REST C RET ;SAVE INTERNAL POINTERS CONCERNING INPUT MODE TYPDEL==2 ; Number of words in relevant pdl entry PUSHTT: PUSH P,A PUSH P,F AOSN CMEOF ; If supposed to pop out of tty soon, CALL POPTT ; Do it now before cmeof clobbered. MOVE F,ITTYP ; Get relevant pdl pointer MOVEI A,0 EXCH A,CLNN ; Set up new line number HRL A,CPGN ; Save current page number SETZM CPGN ; Now re-initialize SKIPGE CRFILE ; Save cref-all-on-one-line flag. TLO A,400000 PUSH F,A ; Save cpgn,,clnn MOVE A,-1(P) ; Retrieve new mode PUSHJ P,PSHLMB ; Save limbo1 and set up instructions for new mode IFN ITSSW,[ CALL SETWH2 .SUSET [.SWHO3,,A] ] MOVEM F,ITTYP ; Store back updated pointer JRST POPFAJ ; Restore internal pointers concerning input mode POPTT: PUSH P,A PUSH P,F MOVE F,ITTYP ; Get pdl pointer PUSHJ P,POPLMB ; Pop into limbo1, set up new mode POP F,A ; Get cpgn,,clnn SETZM CRFILE ; Restore all-on-one-line flag. TLZE A,400000 SETOM CRFILE HLRZM A,CPGN HRRZM A,CLNN IFN ITSSW,[ CALL SETWH2 ADD A,CPGN .SUSET [.SWHO3,,A] ] MOVEM F,ITTYP ; Store back updated pointer JRST POPFAJ IFN ITSSW,[ SETWH2: MOVE A,RCHMOD CAIL A,2 SKIPA A,[SIXBIT /TTY:/] MOVE A,INFB+$F6FN1 .SUSET [.SWHO2,,A] MOVE A,A.PASS LSH A,30 ADD A,[SIXBIT /P0/+1] RET ] SUBTTL Storage for IO PDL stuff ; IO PDL storage stuff VBLK TYPDLS==TYPDLC*TYPDEL+INPDEL*MX.INS ; "tty pdl", stores information about current input mode ; (similar to macro pdl but not garbage collected) ITTYP: -TYPDLS-1,,TTYPDL ; Pdl pointer (typdel=length of each entry) TTYPDL: NEDCHK ; Actual pdl: initial entry to overpop routine BLOCK TYPDLS ; Pdl proper PBLK SUBTTL TNX - IO PDL Routines (IOPDLC, $IOPUSH, $IOPOP) IFN TNXSW,[ IFN PMAPSW,[ ; Push IO buffer & channel... IOBPUS: PUSH P,A MOVEI A,UTYIC CALL $IOPUSH MOVEI A,NIBFPS ; Point at next set of buffer pages. ADDM A,INBFPG POP P,A POPJ P, ; Pop IO buffer & channel... IOBPOP: PUSH P,A MOVE A,INBFPG HRLI A,NIBFPS CALL DELPGS ; flush buffer pages. MOVNI A,NIBFPS ADDM A,INBFPG ; point down at previous set of buffer pages... MOVEI A,UTYIC CALL $IOPOP POP P,A POPJ P, ; DELPGS - Take arg in A as <# pgs>,, and flush these pages. DELPGS: PUSH P,A PUSH P,B HLRZ B,A HRLI A,.FHSLF ; ,, TLO B,(PM%CNT) PUSH P,T DELPG2: SYSCAL PMAP,[[-1] ? A ? B][A ? A ? B] ; Free up buffer pages. TLNN FF,FL20X ; If on 20X, that's all. JRST [ HRRI B,-1(B) ; Else, on 10X, must iterate manually. TRNE B,400000 ; See if became "negative". JRST .+1 ; Yep, done with manual iteration. AOJA A,DELPG2] ; Nope, bump page #'s. POP P,T POP P,B POP P,A POPJ P, ] ;IFN PMAPSW ; IOPDLC - Clear IOPDL stack, close all channels on it. ; Clobbers no ACs ; for 10x, need to CLOSF and release each JFN on IOPDL stack. IOPDLC: PUSH P,T IFN PMAPSW,[ MOVEI T,1STBFP ; Reset to point at 1st page of buffer space. MOVEM T,INBFPG ] EXCH A,IOPDLP JRST IOPDC3 IOPDC2: SYSCAL CLOSF,[(A)] JFCL SUB A,[1,,1] IOPDC3: CAMLE A,[-LIOPDL,,$IOPDL-1] JRST IOPDC2 EXCH A,IOPDLP POP P,T POPJ P, ; $IOPUSH - Push I/O channel in A onto $IOPDL stack. ; Clobbers no ACs ; for 10X this means storing JFN on stack and clearing JFNCHS table entry. $IOPUSH:EXCH B,IOPDLP ; Get stack pointer PUSH B,JFNCHS(A) ; save JFN for channel EXCH B,IOPDLP SETZM JFNCHS(A) ; Zap entry in channel table to make it look gone POPJ P, ; $IOPOP - Pops channel off $IOPDL into channel # in A. ; Clobbers no ACs ; for 10X just pop $IOPDL into JFNCHS, must close and release old JFN tho. $IOPOP: PUSH P,T SYSCAL CLOSF,[JFNCHS(A)] JFCL POP P,T EXCH B,IOPDLP ; Get stack ptr POP B,JFNCHS(A) EXCH B,IOPDLP POPJ P, VBLK JFNCHS: BLOCK 20 ; Channel table index, JFNCHS(ch) gets JFN for chan. ; (zero if none) LIOPDL==8. ; Length of IO PDL IOPDLP: -LIOPDL,,$IOPDL-1 $IOPDL: BLOCK LIOPDL PBLK ] ; IFN TNXSW SUBTTL DEC - IO PDL Routines (IOPDLC) IFN DECSW,[ ; IOPDLC - Simulate ITS .IOPDL call. Flushes all channels from ; UTICHN downwards to UTYIC. Actually not a simulation but something ; that works in the particular situation for which MIDAS uses .IOPDL. IOPDLC: MOVEI A,UTYIC EXCH A,UTICHN ; Set input chnl num. to lowest. LSH A,27 IOR A,[RELEAS] ; Set up to releas the highest in use first. IOPDL1: XCT A ; Releas one input channel, CAMN A,[RELEAS UTYIC,] RET ; All done. SUB A,[0 1,] JRST IOPDL1 ; Releas the next one down. ] ;IFN DECSW SUBTTL COMMON TTY input routines & variables VBLK CMBUF: BLOCK CMBFL ; Typein buffer (also used as JCL buffer) CMPTR: 0 ; Byte pointer to CMBUF. CMEOF: 0 ; -1 => POPTT instead of reloading after this bufferfull. TTYOP: 0 ; -1 => the TTY is already open. LINEL: 0 ; Width of TTY (may be 1,, meaning assume infinite). A.TTYFLG: ; Value of .TTYFLG pseudo - another label for TTYFLG. TTYFLG: 0 ; TTY typeout permitted iff >= 0. WSWCNT: 0 ; The number of W-switches in the last cmd string. TTYBRF: 0 ; -1 => ^H break has been requested but not yet done. PBLK ; Cause input from tty (main routines) GTYIPA: SETZM A.TTYF ; Push to tty, don't stop at cr. IFN ITSSW, TYPECR "TTY: .INSRTed, end input with ^C" IFN DECSW\TNXSW,[ IFE SAILSW,TYPECR "TTY: .INSRTed, end input with ^Z" IFN SAILSW,TYPECR "TTY: .INSRTed, end input with CTL-META-LF" ] GTYIP1: SKIPA A,[3] GTYIP: MOVEI A,2 ; Input from tty, stop after 1 line. SETZM CMPTR ; Force reload on 1st read. JSP B,PUSHTT ; Set up variables and return GTYIPR: SETZM CMPTR ; Return on .ineof or cr JRST POPTT ; Call here from ASSEM1 loop when a ^H interrupt is detected. TTYBRK: SETZM A.TTYF ETR [ASCIZ/^H - break /] ; Type filename, page and line #. SKIPE ASMOUT TYPECR "within a <>, () or []" JRST GTYIPA ; RCHSET routines for reading from TTY ; RCHMOD=3 => don't quit on CR ; 2 => quit on CR. RCHTRC: RCHARC: TLO FF,FLTTY ; Set flag JSP A,CPOPJ RCHAC1: REPEAT 2,[ ; RCH2, RR1 ILDB A,CMPTR ; Get char CAIN A,0 ; End of string marked with 0 PUSHJ P,TYRLDR ; Reload, jump back for next char ] HALT ; RRL1 IFN .-RCHAC1-RCHPSN,.ERR RCHAC1 LOSES. ILDB A,CMPTR ; SEMIC CAIN A,15 JRST SEMICR JUMPN A,SEMIC PUSHJ P,TYRLD JRST SEMIC TYRLD: MOVEI A,3 ; Return after the call, not before. ADDM A,(P) ; TYRLDR - Read in string. ; Reload buffer if ran out in call to RCH. TYRLDR: AOSN CMEOF ; EOF detected after last reload => JRST RPAEOF ; Pop out of tty. PUSH P,A PUSH P,B MOVE B,RCHMOD PUSH P,F PUSH P,A.TTYF ; If chars rubbed out they should be printed. SETZM A.TTYF MOVE F,[10700,,CMBUF-1] ; Initial byte pointer to buffer MOVEM F,CMPTR ; Store as byte pointer for read TYRLD2: PUSHJ P,TYI ; Get character IFN TNXSW,[ CAMN F,CMPTR ; at beg of line? CAIE A,^J ; and char is LF? CAIA JRST TYRLD2 ; If so then ignore it completely. ] CAIN A,177 ; Rubout? JRST TYRLD3 ; Yes CAIE A,^C CAIN A,^Z JRST TYRLD7 ; ^C, ^Z => EOF. Ought to be EOFCH for consistency? CAIN A,^U JRST TYRLD5 ; Rub out all CAIE B,2 ; For .TTYMAC handling, convert lower case to upper. JRST TYRLD6 CAIL A,"A+40 CAILE A,"Z+40 CAIA SUBI A,40 TYRLD6: CAME F,[010700,,CMBUF+CMBFL-2] IDPB A,F ; Store character in buffer unless buffer nearly full. CAIE A,^M ; CR? JRST TYRLD2 ; No, go back for next CAIN B,2 ; .TTYMAC (mode 2) => CR ends input, so fake EOF. SETOM CMEOF MOVEI A,^J ; Follow the CR with a LF. IDPB A,F PUSH P,F ; Output the entire line to the error file MOVE F,[10700,,CMBUF-1] TYRLD8: CAMN F,(P) JRST TYRLD9 ILDB A,F CAIN A,^M ; If line was ended by a ^C or ^Z, put that in error SKIPL CMEOF ; file, which needs hair since that char is not JRST TYRLD0 ; In the string we stored. MOVEI A,"^ CALL ERRCHR IFN ITSSW,MOVEI A,"C IFN DECSW\TNXSW,MOVEI A,"Z CALL ERRCHR LDB A,F TYRLD0: CALL ERRCHR JRST TYRLD8 TYRLD9: REST F MOVEI A,0 IDPB A,F ; Mark end of string IDPB A,F REST A.TTYF REST F REST B REST A JRST RCHTRA TYRLD7: SETOM CMEOF ; ^C, ^Z force EOF, CALL TYRLCR ; After turning into ^M. MOVEI A,^M JRST TYRLD6 TYRLCR: MOVEI A,^M CALL TYOX MOVEI A,^J JRST TYOX TYRLD3: CAMN F,[10700,,CMBUF-1] ; Rubout, beginning of buffer? JRST TYRLD4 ; Yes LDB A,F ; Get last character in buffer CALL TYOX ; Type it out, don't write in error file. ADD F,[70000,,] ; Decrement pointer JUMPGE F,TYRLD2 ; Jump if valid SUB F,[430000,,1] ; Was 440700,,something, back it up JRST TYRLD2 TYRLD5: MOVE F,[10700,,CMBUF-1] ; ^U, back to beginning of line TYRLD4: PUSHJ P,TYRLCR ; Rubout when at beginning of buffer, type CR JRST TYRLD2 SUBTTL ITS - TTY routines (TYOX, TYI, TTYINI) and JCLINI. IFN ITSSW,[ ; TYOX - Type out char in A TYOX: SKIPN TTYOP CALL TTYINI .IOT TYOC,A POPJ P, ; TYI - Get (just typed in) char in A TYI: SKIPN TTYOP CALL TTYINI ; Open the tty if not already done. .IOT TYIC,A ANDI A,-1 ; Non-tty devices can return -1,,3. JUMPE A,TYI CAIN A,^L ; This must be assuming that ^L clears screen? JRST TYI POPJ P, ; Initialize tty TTYINI: PUSH P,A .OPEN TYIC,[.UAI,,'TTY] ; Input .LOSE .OPEN TYOC,[%TJDIS+.UAO,,'TTY] ; Display mode output .LOSE SYSCAL CNSGET,[1000,,TYOC ? 2000,,A ? 2000,,A] MOVSI A,1 ; TTY: is translated to something else => assume infinite linel MOVEM A,LINEL ; Else linel gets width of tty. SETOM TTYOP ; Say the tty is now open. JRST POPAJ JCLINI: SETZM CMPTR .SUSET [.ROPTIO,,A] TLNN A,%OPCMD ; Has our superior said it has a cmd? RET ; No. BLTZ CMBFL-1,CMBUF ; Zero all but last word, SETOM CMBUF+CMBFL-1 ; and ensure last word non-zero. .BREAK 12,[5,,CMBUF] ; Try to read command string. MOVE A,[440700,,CMBUF] SKIPE CMBUF ; If read a cmd-string, MOVEM A,CMPTR ; Tell TYRLD, GO2A it's there. POPJ P, ]; END IFN ITSSW SUBTTL TNX - TTY routines (TYOX, TYI, TTYINI) and JCLINI IFN TNXSW,[ ; TYOX - Type out char in A TYOX: SKIPN TTYOP CALL TTYINI IFN A-1,EXCH A,R1 PBOUT IFN A-1,EXCH A,R1 POPJ P, ; TYI - Get (just typed in) char in A ; There is a screw for 20X in that it's not really possible ; to know if the system is going to feed you a CR-LF ; or just a CR; TYRLD2 checks for that, by flushing LF's, but ; this would be the place to check if it were easy to do. TYI: SKIPN TTYOP CALL TTYINI ; Open the tty if not already done. IFN A-1,EXCH R1,A PBIN ; Get char into AC 1 JUMPE R1,.-1 ; Ignore nulls. TLNE FF,FL20X ; Cretinous differences between 10X/20X JRST TYI2 ; 20X, skip EOL check. CAIN R1,^_ ; On 10X, CR turned into ^_ (EOL); change it back. MOVEI R1,^M TYI2: IFN A-1,EXCH R1,A ; Restore everything to right place if necessary. POPJ P, ; TTYINI - Initialize tty TTYINI: PUSH P,A PUSH P,T SYSCAL RFMOD,[[.PRIIN]][A ? A] POP P,T HLRZS A ANDI A,177 ; Terminal width CAIGE A,30. ; If too low, ADDI A,128. ; Assume twenex crockishness MOVEM A,LINEL ; Linel gets width of tty. SETOM TTYOP ; Say the tty is now open. POP P,A POPJ P, ; Read "JCL" - RSCAN buffer or nnnMID.TMP file (from CCL) JCLINI: SETZM CMPTR SKIPE CCLFLG ; Started at CCL location? JRST JCLIN5 ; Yep, go snarf stuff specially. TLNN FF,FL20X ; Is this Tenex? JRST [ MOVEI R1,.PRIIN BKJFN ; see what previous character was POPJ P,; *Gasp* PBIN CAIE R1,^_ ; Tenex newline? SETOM CMPTR ; No, set flag saying "TTY but no prompt" POPJ P,]; and skip the Twenex hackery below SETZ R1, ; If not, check RSCAN. RSCAN ; See if have anything in RSCAN buffer. POPJ P, ; Huh? Shouldn't happen, but ignore it. JUMPLE R1,APOPJ ; Also return if char cnt says nothing there. MOVNI R3,(R1) ; Aha, set up cnt for SIN HRROI R2,CMBUF MOVEI R1,.PRIIN ; Now ready for business... SIN LDB R1,R2 ; Now examine wages thereof CAIE R1,^M ; Last char CR? JRST [ MOVEI R1,^M IDPB R1,R2 ; If not, make it so. JRST .+1] SETZ R1, IDPB R1,R2 ; Must also ensure ASCIZ. MOVE B,[440700,,CMBUF] ; If the rescan line starts with "RUN ", skip that. IRPC X,,[RUN ] ILDB A,B CAIE A,"X JRST JCLIN4 TERMIN CAIA JCLIN4: MOVE B,[440700,,CMBUF] ; Now flush the name of the file MIDAS was run from. ILDB A,B CAILE A,40 JRST .-2 ; Flush until random ctl seen (space, ^M) CAIE A,40 ; If it wasn't a space, POPJ P, ; then forget about the whole thing. JCLIN3: MOVE C,B ; Now flush spaces. Save last ptr for chars. ILDB A,B CAIN A,40 JRST JCLIN3 CAIN A,^M ; And is first non-space something besides CR? POPJ P, ; Bah, there wasn't anything in the JCL!! MOVEM C,CMPTR ; Else save ptr to start of real goods. POPJ P, ; TNX snarf of CCL file. No such thing as tmpcor, so just ; look for real file with appropriate name. JCLIN5: SETZM CCLFLG ; Want 0 in case abort out, will reset if win. GJINF ; Get job # in R3 HRROI R1,CMBUF ; Use CMBUF to form filename string. MOVEI R2,(R3) MOVE R3,[NO%LFL+NO%ZRO+<3_18.>+10.] NOUT ; ship out job num in 3 digits, radix 10. HALT HRROI R2,[ASCIZ /MID.TMP/] SETZ R3, SOUT ; Flesh out rest of filename string. SETZ R2, ; Make sure it's ASCIZ. BOUT MOVE R1,[GJ%OLD+GJ%SHT] ; Use short-form GTJFN HRROI R2,CMBUF ; and gobble name from CMBUF. GTJFN POPJ P, ; If failed, forget it. MOVE R2,[070000,,OF%RD] ; Read 7-bit bytes OPENF POPJ P, ; Bah HRROI R2,CMBUF ; Gobble stuff up. MOVEI R3,CMBFL*5 ; Read until buffer full, MOVEI R4,^J ; or LF seen. SIN JUMPLE R3,APOPJ ; Forget it if too big for buffer!! MOVE R2,[440700,,CMBUF] ; Aha, we've got something, so set MOVEM R2,CMPTR ; pointer to slurped stuff. SETOM CCLFLG HRROI R2,UTIBUF ; Slurp rest into larger buffer, MOVNI R3,UTIBFL*5 ; using count only. SIN JUMPGE R3,APOPJ ; Refuse to hack grossly large file. ADDI R3,UTIBFL*5 JUMPLE R3,APOPJ ; if nothing read, need write nothing out. HRLI R1,(CO%NRJ) ; Don't release JFN, CLOSF ; but stop reading from file. POPJ P, MOVE R2,[070000,,OF%WR] ; Now try to hack write access. OPENF POPJ P, MOVE R2,R1 ; Source becomes destination... HRROI R1,UTIBUF ; and UTIBUF becomes source, MOVNS R3 ; for just as many bytes as were read. SOUT MOVEI R1,(R2) ; done, now just close file. CLOSF ; (this time, release JFN). POPJ P, SETOM CCLMOR ; say that more CCL remains. POPJ P, ] ; END IFN TNXSW SUBTTL DEC - TTY routines (TYOX, TYI, TTYINI) IFN DECSW,[ ; TYOX - Type out char in A TYOX: SKIPN TTYOP CALL TTYINI OUTCHR A POPJ P, ; TYI - Get a typed-in char in A TYI: SKIPN TTYOP ; Open the tty, if not already done. CALL TTYINI INCHWL A IFN SAILSW,[ CAIN A,612 ; On SAIL, EOF is 612, MOVEI A,^Z ; so turn into normal EOF if found. ] CAIE A,^M ; Throw away the LF after a CR. RET INCHWL A MOVEI A,^M ; Note that TYRLDR will put it back in. RET TTYINI: INSIRP PUSH P,AA A B IFE SAILSW,[ PJOB A, TRMNO. A, JRST TTYIN1 MOVEI AA,1012 ; .TOWID MOVE B,[2,,AA] TRMOP. B, ; Read width of tty line into B. ] TTYIN1: MOVEI B,80. ; TRMOP. failed or not tried => assume width is 80. MOVEM B,LINEL INSIRP POP P,B A AA SETOM TTYOP RET TMPLOC .JBREN, TTYREN TTYREN: SETOM TTYBRF ; "REENTER" command comes here R: G: JRST @.JBOPC ; To request a ^H-break. Note crufty labels pointing here. ];IFN DECSW SUBTTL DEC Hackery for JCLINI - Read CCL commands. IFN DECSW\TNXSW,[ VBLK CCLFLG: 0 ; Flag to indicate CCL entry from COMPIL, SNAIL, CCL, or EXEC CCLMOR: 0 ; -1 => There are more lines of CCL commands, ; so do a RUN SYS:MIDAS when finished. PBLK ] IFN DECSW,[ ; DEC only hacks CCL as "JCL". .SCALAR CCLFIL ; Saves FN1 for tmp file hacking. ; Read MID temp core file, if that loses, try nnnMID.TMP file. ; Clobbers A,B,C,D. JCLINI: SETZM CMPTR SKIPN CCLFLG ; Was midas called from CCL level? RET ; No, do not snarf tempcore SETZM CCLFIL ; No CCL file yet SETZM CCLFLG ; If tmpcor loses want this 0 (will re-setom below) BLTZ CMBFL,CMBUF ; Zero cmd buffer. MOVE A,[2,,['MID,, ? -,,CMBUF-1]] ; read (leave last wd 0) TMPCOR A, ; Read compil-generated command JRST [ OPEN [17 ? 'DSK,, ? 0] ; No tempcore, maybe try dump mode. RET ; Argh but let something else die PJOB A, ; Get job # IDIVI A,100. ; Want decimal job number in sixbit ADDI A,'0 LSH A,6 IDIVI B,10. ADDI A,'0(B) LSH A,6 ADDI A,'0(C) LSH A,18. HRRI A,'MID ; Form file name as nnnMID.TMP MOVEM A,CCLFIL ; Save for writing below MOVSI B,'TMP SETZB C,D ; No protect or ppn trash LOOKUP A ; Try to get file RET ; Give up MOVE A,[-,,CMBUF-1] SETZ B, INPUT A ; Try to read command SETZB A,B RENAME A ; Try to delete it now JFCL ; Ignore failure CLOSE ; Happy sail JRST .+1] SKIPN CMBUF ; One last check for it to be there RET ; Alas, there is none MOVE A,[440700,,CMBUF] ; Load a byte pointer to the command SETOM CCLFLG MOVEM A,CMPTR ; There is, set command pointer JCLIN1: ILDB B,A CAIE B,^J ; See if our command file has anything after 1st line. JRST JCLIN1 ILDB B,A JUMPE B,JCLIN3 SETOM CCLMOR ; It does; set flag so after handling 1st line we'll MOVE C,[440700,,UTIBUF+2] JCLIN2: IDPB B,C ILDB B,A JUMPN B,JCLIN2 SUBI C,UTIBUF+1 ; Get # words written in utibuf. operand is relocatable! HRLOI C,-1(C) ; These 2 insns turn size into -size,,utibuf+1 EQVI C,UTIBUF+1 MOVEM C,UTIBUF+1 SKIPE A,CCLFIL ; Was this called with a temp file? JRST [ MOVSI B,'TMP SETZB C,D ENTER A ; Try to re-write file RET ; Sigh MOVE A,UTIBUF+1 SETZ B, OUTPUT A RELEASE RET] MOVSI C,'MID MOVEM C,UTIBUF MOVE C,[3,,UTIBUF] TMPCOR C, JFCL ; [KLH - there used to be some random cruft here.] JCLIN3: RET ] ;END IFN DECSW SUBTTL Old Command Line Reader (CMD) ifn 0,[ ; Read command & filenames & hack defaulting. CMD: SKIPE CMPTR ; Unless have DDT or RSCAN cmd string, JRST CMD06 ; (we don't) CALL CRR ; type a CRLF, prompt etc. CMD05: SETZM CMPTR TYPE "*" CMD06: MOVEI A,3 ; Read from TTY (or string <- cmptr) CALL RCHSET MOVEI F,FB ; Point to scratch filblk. BLTZ L$FBLK,FB ; and clear the whole thing. TRO FF,FRCMND ; Tell RFD it's scanning a command line. CALL RFD ; Now see if command null, and whether has _. IFN DECSW\TNXSW,[ CAIN A,"! ; If terminator was "!", go run program. JRST RFDRUN ] TRNN FF,FRNNUL ; If no filespec was seen, CAIE A,^M ; and terminator is EOL, CAIA JRST CMD05 ; then prompt again and get another string. TRZ FF,FRARRO ; Got something, clear saw-"_" flag. CMD07: CAIN A,"_ TRO FF,FRARRO ; FRARRO will be on if there's a "_" in string. CAIN A,^M JRST CMD1 ; Read thru the whole command. CALL RFD JRST CMD07 ; Now re-read the string, for real this time. Previous scan was ; mainly just to see if "_" existed. If not, then first filename ; must be input file, and output filenames are all defaulted. CMD1: MOVE T,[440700,,CMBUF] ; Restore original ptr to MOVEM T,CMPTR ; beginning of string. IFN CREFSW,SETZM CREFP ; Clear all switches before decoding them. INSIRP SETZM 0,ERRFP TTYINS WSWCNT IFN LISTSW,[ SETZM LISTP SETOM LISTP1 ; Will be AOSed by each (L) switch. ] MOVE T,FSDSK MOVEM T,$FDEV(F) IFE TNXSW,[MOVE T,RSYSNM ? MOVEM T,$FDIR(F)] IFN TNXSW, SETZM $FDIR(F) SETZM $FNAME(F) SETZM $FEXT(F) TRZ FF,FRNNUL TRNE FF,FRARRO ; Don't gobble input spec as output! CALL RFD ; Read bin file spec. MOVE TT,FF ; Remember whether null BLTMAC T,L$FBLK,(F),OUTFB ; Copy from scratch to OUTFB. MOVE T,$FDEV(F) CAMN T,FSNUL MOVE T,FSDSK MOVEM T,$FDEV(F) IFE ITSSW, MOVE T,FSCRF IFN ITSSW, MOVE T,FSCREF MOVEM T,$FEXT(F) TRNN FF,FRARRO ; If "_" doesn't exist in cmd line, MOVEI A,"_ ; then only filespec is for input, kludge to get it. CAIN A,"_ ; If "_" exists in cmd line, did we hit it? JRST CMD2 ; Ran out of output specs => just use defaults. CALL RFD ; Read cref file spec. IFN CREFSW,[ TRNN FF,FRNNUL ; If spec not null or ended by _, CAIN A,"_ SETOM CREFP ; We must want to cref. CMD2: BLTMAC T,L$FBLK,(F),CRFFB ; Copy specs from FB to CREF FB. ] IFE CREFSW,CMD2: MOVE T,FSERR MOVEM T,$FEXT(F) CAIN A,"_ JRST CMD6 ; No more output specs. CALL RFD ; Read error file sppec. IFN ERRSW,[ TRNN FF,FRNNUL ; Nonnull spec or last spec => CAIN A,"_ SETOM ERRFP ; Must want an error file. CMD6: BLTMAC T,L$FBLK,(F),ERRFB ; Copy specs from FB to ERR filblk. ] IFE ERRSW,CMD6: IFN LISTSW,[ IFE ITSSW, MOVE T,FSLST IFN ITSSW, MOVE T,FSLIST MOVEM T,$FEXT(F) CAIN A,"_ ; Any output spec remaining? JRST CMD3 CALL RFD ; Yes, read one. SETOM LISTP ; List spec given implies want listing. CMD3: BLTMAC T,L$FBLK,(F),LSTFB ; Copy specs from FB to LST filblk. ] CMD5: CAIN A,"_ JRST CMD4 CALL RFD ; Ignore any output specs not needed. JRST CMD5 CMD4: MOVE T,FSDSK ; Default the input names. MOVE A,$FDEV(F) CAME A,FSPTP ; Don't leave dev name set to common out-only devs. CAMN A,FSNUL MOVEM T,$FDEV(F) IFE ITSSW, MOVE T,FSMID IFN ITSSW, MOVE T,FSGRTN ; > on ITS. MOVEM T,$FEXT(F) MOVE T,FSPROG SKIPN $FNAME(F) ; The fn1 alone is sticky across the _. MOVEM T,$FNAME(F) TRZ FF,FRARRO ; If only 1 name it should be FNAM1. CALL RFD ; Read input spec. BLTMAC T,L$FBLK,(F),ISFB ; Copy into specified-input filblk. MOVE T,$FNAME(F) ; Default output FN1's to input. SKIPN OUTFB+$FNAME MOVEM T,OUTFB+$FNAME IFN CREFSW,[ SKIPN CRFFB+$FNAME MOVEM T,CRFFB+$FNAME ] IFN LISTSW,[ SKIPN LSTFB+$FNAME MOVEM T,LSTFB+$FNAME ] IFN ERRSW,[ SKIPN ERRFB+$FNAME MOVEM T,ERRFB+$FNAME ] MOVE A,FSNUL ; The output dev defaults to NUL: MOVE T,$FDEV(F) ; If the input is from TTY: CAMN T,FSTTY TRNE FF,FRNNUL ; And the bin spec was null. CAIA MOVEM A,OUTFB+$FDEV TRZ FF,FRARRO ; Don't louse up .INSRT's reading. RET ] ;ifn 0 SUBTTL Command Line Reader (CMD) ; CMD - Read command & filenames & hack defaulting. .SCALAR CMDPSV ; Saves read ptr into CMBUF, for re-scanning. CMD: SKIPE T,CMPTR ; If we have DDT or RSCAN or CCL string, JRST CMD06 ; go hack it without typing anything out. CAMN T,[-1] ; If Tenex-type "JCL", normal TTY input 'cept no prompt JRST CMD06X CALL CRR ; Nope, must type a CRLF, prompt etc. CMD05: TYPE "*" CMD06X: SETZB T,CMPTR CMD06: MOVEM T,CMDPSV ; Save pointer for later restoration MOVEI A,3 ; Read from TTY (or string <- cmptr) CALL RCHSET MOVEI F,ISFB ; Point to input-spec filblk. BLTZ L$FBLK,(F) ; Zap it through and through. TRO FF,FRCMND ; Tell RFD it's scanning a command line. CALL RFD ; Now see if command null, and whether has _. IFN DECSW\TNXSW,[ CAIN A,"! ; If terminator was "!", go run program. JRST RFDRUN ] TRNN FF,FRNNUL ; If no filespec was seen, CAIE A,^M ; and terminator is EOL, CAIA JRST CMD05 ; then prompt again and get another string. TRZA FF,FRARRO ; Got something, clear saw-"_" flag. CMD07: CALL RFD CAIN A,"_ JRST [ TRO FF,FRARRO ; FRARRO will be on if there's a "_" in string. CALL RFD ; Gobble next filename, input filespec. JRST CMD1] CAIE A,^M JRST CMD07 ; Read thru the whole command until read input filespec ; Now re-read the string, for real this time. Previous scan was ; mainly to latch onto input filespec and see if "_" existed. CMD1: SKIPN T,CMDPSV ; Restore original ptr if there's one, MOVE T,[440700,,CMBUF] ; else point at beg of buffer. MOVEM T,CMPTR SETZM TTYINS ? SETZM WSWCNT ; Clear all switches. IFN CREFSW,SETZM CREFP IFN ERRSW, SETZM ERRFP IFN LISTSW,SETZM LISTP ? SETOM LISTP1 ; Will be AOSed by each (L) switch. SETZ A, TRNN FF,FRARRO ; If "_" doesn't exist in cmd line, MOVEI A,"_ ; then only filespec is for input, kludge to get it. MOVEI F,OUTFB BLTZAC T,L$FBLK,(F) ; Clear output filblk. MOVE T,FSDSK ; Default dev to DSK. MOVEM T,$FDEV(F) SKIPN T,$FNAME+ISFB ; Now default FN1 from input filespec MOVE T,FSPROG ; (use "PROG" if none) MOVEM T,$FNAME(F) IFE TNXSW,[MOVE T,RSYSNM ; Now default directory if need to MOVEM T,$FDIR(F)] TRZ FF,FRNNUL CAIE A,"_ ; If it exists, CALL RFD ; Read bin file spec. TRNN FF,FRNNUL ; If spec was null, JRST [ MOVE T,FSTTY ; and input spec was TTY:, CAME T,$FDEV+ISFB JRST .+1 MOVE T,FSNUL ; then set device to NUL:. MOVEM T,$FDEV(F) JRST .+1] DEFINE CFMAC SWIT,PTR,INSTR,DEXT IFN SWIT,[ MOVE T,DEXT MOVE TT,[[INSTR],,PTR] ] .ELSE SETZB T,TT PUSHJ P,CMDFGT TERMIN CFMAC CREFSW,CRFFB,[SETOM CREFP][IFN ITSSW,[FSCREF] .ELSE FSCRF] CFMAC ERRSW, ERRFB,[SETOM ERRFP] FSERR CFMAC LISTSW,LSTFB,[SETOM LISTP][IFN ITSSW,[FSLIST] .ELSE FSLST] CMD50: CAIE A,"_ JRST [ SETZB T,TT ; Point to scratch FB etc. CALL CMDFGT ; Ignore any output specs not needed. JRST CMD50] ; Must do this way to retain default stuffs. ; Finally read input file. BLTMAC T,L$FBLK,(F),ISFB ; Copy last stuff to input spec MOVEI F,ISFB ; and point at it. PUSHJ P,CMDDVX ; Hack device-name default. IFE ITSSW, MOVE T,FSMID IFN ITSSW, MOVE T,FSGRTN ; > on ITS. MOVEM T,$FEXT(F) CALL RFD ; Read input spec. RET ; Yep, that's really all! ; TT has ,, ; T has default $FEXT. ; Takes defaults from current F, sets F to new filblk. CMDFGT: JUMPE TT,[SETZ T, ; If 0, do usual but into oblivion (scratch FB) MOVE TT,[[JFCL],,FB] JRST .+1] BLTMAC B,L$FBLK,(F),(TT) ; Copy from current filblk to new. MOVE F,TT ; set new F. MOVEM T,$FEXT(F) ; Set default $FEXT PUSHJ P,CMDDVX ; Set up device, defaulting to DSK. CAIN A,"_ ; If last delimiter was start of input spec, POPJ P, ; don't read anything - just use defaults. PUSHJ P,RFD TRNN FF,FRNNUL ; If spec non-null or CAIN A,"_ ; ended by _, then CAIA ; hack specified instr. POPJ P, HLRZ T,F XCT (T) POPJ P, CMDDVX: SKIPN T,$FDEV(F) MOVE T,FSDSK CAME T,FSPTP CAMN T,FSNUL MOVE T,FSDSK MOVEM T,$FDEV(F) POPJ P, SUBTTL ITS/DEC Filename Reader/printer (RFD, TYPFB) IFN DECSW\ITSSW,[ ; Begin moby conditional for sixbit reader. ; RFD - Reads a single file description from .INSRT or command line, ; using RCH, into specified FILBLK. ; F points at FILBLK to store description in. ; Implements crufty ^R hack (if see ^R, act as if just starting to ; read filename, so effect is stuff before ^R has set defaults.) ; If FRCMND set, recognize -, comma, / and ( as special characters, ; and hack switches. ; Sets FRNNUL if spec was nonnull. ; Clobbers A,B,C only. RFD: TRZ FF,FRNNUL RFD01: SETZM RFDCNT ; Zero cnt of "normal" filenames. Jump here if see ^R. RFD10: PUSHJ P,GPASST ; Flush out spaces/tabs TRNN FF,FRCMND ; If parsing command line, CAIE A,"; ; or if char isn't semi-colon, JRST RFD22 ; just handle normally. RFD15: PUSHJ P,RCH ; Semi-colon and not command line!! Flush rest CAIE A,^M ; of line, assuming it's a comment! JRST RFD15 POPJ P, RFD2: PUSHJ P,RCH ; Get character in A RFD20: CAIE A,40 ; Space (Come here to scan already-read char.) CAIN A,^I ; or tab? JRST RFD10 ; Ach, go into flush-whitespace loop. RFD22: CAIN A,^M ; End of line? POPJ P, ; If so, obviously done. CAIN A,^R ; Crufty ^R hack? JRST RFD01 ; Sigh, pretend just starting to read filename. TRNN FF,FRCMND ; Reading command line? JRST RFD40 ; Nope, skip over cmnd-line frobs. ; Reading cmd line, test special chars. IFN ITSSW\SAILSW, CAIN A," ; SAIL underscore, ITS backarrow like _. .ELSE CAIN A,"= ; Either gets munged, MOVEI A,"_ ; into canonical "_". CAIE A,"_ ; Backarrow is output_input marker. CAIN A,", ; Comma is also a terminator... POPJ P, IFN DECSW\TNXSW,[ ; I'm not sure if this belongs here, but CAIN A,"! .SEE RFDRUN POPJ P, ] PUSHJ P,CMDSW ; Check for switches... JRST RFD20 ; Got some, scan next char (returned by CMDSW) ; Got none, drop thru. ; No special delimiters, ; Check for chars which signal what following word is. RFD40: IFN DECSW,[ CAIN A,"[ ;] Left bracket signals start of PPN. JRST [ PUSHJ P,RFDPPN ; Slurp it up, MOVEM C,$F6DIR(F) ; store it, TRO FF,FRNNUL ; saying spec not null. JRST RFD20] ; and go process leftover delimiter. CAIN A,". ; Period signals start of extension. JRST [ PUSHJ P,RCH ; Get the next character PUSHJ P,RFDW ; Read in a word. MOVEM C,$F6EXT(F) ; Store it... TRO FF,FRNNUL ; and say spec non-null (even if C/ 0) JRST RFD20] ; and process delimiting char. ] ; Here, char doesn't signal the start of anything, so we'll assume ; it's the start of a name. PUSHJ P,RFDW ; Gobble up a word. JUMPE C,RFD2 ; If nothing was read, must ignore char; get another. ; Aha, name was read, now examine delimiter to see if it specifies ; anything we know about. TRO FF,FRNNUL ; Set flag saying spec non-null. CAIN A,": ; If colon... JRST [ MOVEM C,$F6DEV(F) ; Then store name as device. JRST RFD2] ; and flush delimiter. IFN ITSSW,[ CAIN A,"; ; If semicolon... JRST [ MOVEM C,$F6DIR(F) ; Then store name as directory (sname) JRST RFD2] ; and flush delimiter. ] ; Whatever it is, at this point delimiter doesn't signify anything ; special in terms of what the name is. So we just store it, using ; the usual FN1 FN2 DEV DIR sequence, and hand delimiter off to ; the prefix scanning stuff. MOVE B,RFDCNT ; Get current count for random names. XCT RFDTAB(B) ; Either MOVEM C, to right place, or ignore AOS RFDCNT ; by skipping over this instr. JRST RFD20 ; and go examine delimiter. .SCALAR RFDCNT ; Count to index RFDTAB by. RFDTAB: MOVEM C,$F6FNM(F) ; 1st name. MOVEM C,$F6EXT(F) ; 2nd name. MOVEM C,$F6DEV(F) ; 3rd name is dev. MOVEM C,$F6DIR(F) ; 4th is sname. CAIA ; 5th and on ignored, don't incr. cnt. ; RFDW - Reads a "word" - any string of contiguous SIXBIT chars, ; barring certain delimiters, and leaves SIXBIT result in C. ; Begins reading with char currently in A. Returns with delimiter ; char in A (it's possible this can be the same char!) ; Clobbers B. RFDW: SETZ C, ; First things first, zap result. SKIPA B,[440600,,C] RFDW2: PUSHJ P,RCH CAIN A,^Q ; Is char the quoter char? JRST [ PUSHJ P,RCH ; Yup, gobble next... CAIN A,^M ; and accept anything but CR POPJ P, ; since that terminates the whole line. JRST RFDW7] ; OK, go stuff the char into C. CAIE A,40 ; Space CAIN A,^I ; or tab POPJ P, ; is always a break. CAIN A,^M ; As is CR. POPJ P, TRNN FF,FRCMND ; And certain chars are bummers when reading cmd. JRST RFDW4 CAIE A,"/ CAIN A,"( POPJ P, IFN DECSW\TNXSW, CAIE A,"= CAIN A,"_ POPJ P, IFN ITSSW\SAILSW, CAIE A," CAIN A,", POPJ P, IFN DECSW\TNXSW,[ CAIN A,"! POPJ P, ] ; Not reading cmd line, or no cmd-line type chars seen. RFDW4: IFN ITSSW,[ CAIE A,": ; For ITS filenames, these chars are special. CAIN A,"; POPJ P, ] IFN DECSW,[ CAIL A,140 ; For DEC, allow only alphanumeric. SUBI A,40 ; cvt to uppercase, then CAIL A,"A ; see if alpha. CAILE A,"Z JRST [CAIL A,"0 ; Nope, see if numeric. CAILE A,"9 POPJ P, ; Not alphanumeric, assume delimiter. JRST .+1] ] RFDW7: TLNN B,770000 ; Enough room in C for another char? JRST RFDW2 ; Nope, ignore it and get next. CAIL A,140 ; Enuf room, cvt lower to uppercase SUBI A,40 SUBI A,40 ; and cvt to sixbit, IDPB A,B ; and deposit. JRST RFDW2 ; Get another. ] ; END IFN DECSW\ITSSW IFN DECSW,[ ; PPN Reader RFDPPN: PUSHJ P,RFDOCT ; Read project num, IFN CMUSW, JUMPE C,RCMUPP ; At CMU watch for our funny ppns HRLM C,(P) PUSHJ P,RFDOCT ; Read programmer num. HLL C,(P) POPJ P, IFE SAILSW,RFDOCL=="0 ? RFDOCH=="8 ; Read octal numbers. IFN SAILSW,RFDOCL==40 ? RFDOCH==140 ; Read sixbit (right-justified). RFDOCT: SETZ C, ; Read octal num, return in C. RFDOC1: PUSHJ P,RCH CAIL A,140 SUBI A,40 IFN SAILSW,[ ;[ ; Even if reading sixbit names (for SAIL), CAIE A,", ; Comma and closebracket are still special. CAIN A,"] POPJ P, ] CAIL A,RFDOCL CAIL A,RFDOCH POPJ P, ; Not octal or not 6bit, return. IMULI C,RFDOCH-RFDOCL ADDI C,-RFDOCL(A) JRST RFDOC1 IFN CMUSW,[ ; [ RCMUPP: CAIN A,"] ; Watch out for [] POPJ P, REPEAT 4, SETZM PPNBUF+.RPCNT MOVE C,[440700,,PPNBUF] RCMUPL: CAIE A,^M ; Don't look too far SKIPE PPNBUF+3 JRST RCMUPD IDPB A,C PUSHJ P,RCH ; [ CAIE A,"] JRST RCMUPL RCMUPD: MOVE A,[C,,PPNBUF] CMUDEC A, SETZ C, POPJ P, .VECTOR PPNBUF(4) ; Storage to buffer up a string for CMUDEC uuo to scan. ] ;IFN CMUSW ] ;IFN DECSW IFN DECSW\ITSSW,[ ; TYPFB - Type out current filblk (what F points at) as file specification ; Clobbers A,B,C TYPFB: MOVSI C,-3-ITSSW HRR C,F TYPF1: MOVE B,$F6DEV(C) ; Get next name PUSHJ P,SIXTYO ; Type out name HLRZ A,C MOVE A,FILSPC+3+ITSSW(A) ; Now get delimiting character PUSHJ P,TYOERR ; Type out AOBJN C,TYPF1 ; Loop for all names IFN ITSSW, POPJ P, IFN DECSW,[ SKIPN B,$F6DEV(C) ; On DEC system PPN is a special case POPJ P, MOVEI A,"[ ;] CALL TYOERR IFN CMUSW,[ MOVE A,[B,,PPNBUF] DECCMU A, JRST OCTPPN TYPR PPNBUF JRST PPNRB ] IFE SAILSW,[ OCTPPN: HLRZ B,$F6DEV(C) ; LH is proj, CALL OCTPNT ] .ELSE [ HLLZ B,$F6DEV(C) CALL SIXTYO ] MOVEI A,", CALL TYOERR IFE SAILSW,[ HRRZ B,$F6DEV(C) CALL OCTPNT ; RH is prog. ] .ELSE [ HRLZ B,$F6DEV(C) CALL SIXTYO ] PPNRB: ; [ MOVEI A,"] JRST TYOERR ];IFN DECSW FILSPC: ": IFN ITSSW, 40 ? 40 ? "; IFN DECSW, ". ? 0 ] ; END IFN DECSW\ITSSW SUBTTL Command switches ; CMDSW - Hacks either a single switch or switch list; A should ; contain "/ for the former, "( for the latter. ; Returns in A next char after switch hackery done. This may be ^M. ; Skip returns if neither "/ nor "( was furnished to it. CMDSW: CAIN A,"/ ; Single switch? JRST [ PUSHJ P,RCH ; Get next char CAIN A,^M POPJ P, PUSHJ P,CMDSW1 PJRST RCH] CAIE A,"( ; Switch list? JRST POPJ1 ; Neither slash nor paren, make skip return. CMDSWL: PUSHJ P,RCH CAIN A,^M POPJ P, CAIN A,") PJRST RCH PUSHJ P,CMDSW1 JRST CMDSWL ; Command switch processing. CMDSW1 processes the switch char ; in A. CMDSW1: CAIL A,140 ; Lower case to upper. SUBI A,40 CAIN A,"T SOS TTYINS ; Count # T-switches. CAIN A,"W ; W - prevent tty messages, and IFE ERRSW,AOS WSWCNT ; request error output file if possible. .ELSE [ AOSA WSWCNT CAIN A,"E ; E - request error log file. SETOM ERRFP ] IFN CREFSW,[ CAIN A,"C ; C - request CREF output. SETOM CREFP ] IFN LISTSW,[ CAIE A,"L ; L - request listing POPJ P, SETOM LISTP ; Say want listing. AOS LISTP1 ; (starts as -1, will be positive after 2nd (L)) ] POPJ P, SUBTTL TENEX Filename Reader/printer (RFD, TYPFB) IFN TNXSW,[ ; Moby conditional for Tenex reader. ; TNXRFD - TENEX-style Filename Reader. ; Takes input from RCH, ; Deposits name strings into filblk F points to. ; Clobbers A,B,C,D, (and AA,T,TT due to FNCHK) ; Uses FRFEXT flag to see if already read extension (type) or not. ; Refuses to accept existing defaults for version, ;T, account, ; protection, or JFN. It will also zap an existing directory ; default if a device is specified, and vice versa. This is so that ; logical names will win a little better. ; Implements crufty ^R hack (if see ^R, act as if just starting to ; read filename, so effect is stuff before ^R has set defaults.) IFNDEF FRFDEV,FRFDEV==2 ; Set if read device. IFNDEF FRFDIR,FRFDIR==1 ; Set if read directory. IFNDEF FRFEXT,FRFEXT==FRFN1 ; Borrow this bit. Set if read extension. RFD: TRZ FF,FRNNUL SETZM $FJFN(F) ; Zap JFN since the filename we'll read won't match it. SETZM $FACCT(F) ; Also zap other things that we don't want defaulted. SETZM $FPROT(F) SETZM $FTEMP(F) SETZM $FVERS(F) TRFD01: TRZ FF,FRFEXT+FRFDEV+FRFDIR ; Jump here if ^R seen. TRFD10: PUSHJ P,GPASST ; remove tabs, spaces and get first non-tab/space TRNN FF,FRCMND ; If parsing command line, CAIE A,"; ; or if char isn't semicolon, JRST TRFD21 ; just handle normally. TRFD15: PUSHJ P,RCH ; Semi-colon and not command line, it's a comment! CAIE A,^M ; So flush rest, up to EOL. JRST TRFD15 POPJ P, TRFD1: TLO FF,FLUNRD ; come here to re-read last char TRFD2: PUSHJ P,RCH ; Get char TRFD21: CAIE A,40 ; Space? (come here to scan already-read char) CAIN A,^I ; or tab? JRST [TRNE FF,FRCMND ; Space/tab, if reading command line JRST TRFD2 ; then ignore and continue scanning (for switches), but JRST TRFD15] ; if not in cmd line, go flush entire rest of line! CAIN A,^M ; End of line? POPJ P, ; If so, obviously done. CAIN A,^R ; Crufty ^R hack? JRST TRFD01 ; Sigh, pretend starting over. TRNN FF,FRCMND ; Must we check for cmd line frobs? JRST TRFD22 ; Nope, skip them. ; Must check for chars special only in command line. CAIN A,"= MOVEI A,"_ CAIE A,"_ ; backarrow is filename terminator... CAIN A,", ; as is comma. POPJ P, CAIN A,"! ; For CCL hacking... POPJ P, .SEE RFDRUN PUSHJ P,CMDSW ; Check for switches... JRST TRFD21 ; got some, process next char (returned by CMDSW) ; Skips if none, drop thru. ; Now see if char signifies start of anything in particular. TRFD22: CAIE A,"< ; Start of directory name? JRST TRFD24 ; No PUSHJ P,RCH PUSHJ P,TRFDW ; Read word, starting with next char TRFD23: CAIN A,". ; Allow . as part of directory name JRST [ PUSHJ P,TRFDW5 ; Read a continuation to this word JRST TRFD23] ; And try again MOVEI D,$FDIR ; Set up index. CAIN A,"> ; Terminator should be end of dir name... PUSHJ P,RCH ; If so, get next to avoid scan of ">". ; else bleah, but aren't supposed to fail... TRNN FF,FRFDEV ; Unless a device has been explicitly given, SETZM $FDEV(F) ; zap any furnished default. 0 means DSK. TRO FF,FRFDIR ; Now say dir was explicitly given. JRST TRFD6 ; Go store it. TRFD24: CAIN A,". ; Start of $FTYPE or $FVERS (20x)? JRST [ MOVEI D,$FTYPE ; Assume reading $FTYPE field, TLNE FF,FL20X ; always if 10X, but if really on 20X, then TRON FF,FRFEXT ; use $FTYPE only if not already seen. JRST TRFD4 ; $FTYPE - jump to get word & store. PUSHJ P,TRFDNM ; $FVERS - 20X and $FTYPE already seen. Get #. MOVEM B,$FVERS(F) ; Store it away if successful. JRST TRFD1] ; and go re-read delimiting char. CAIN A,"; ; Start of $FVERS (10x) or attribute? JRST [ PUSHJ P,RCH ; Find what next char is. CAIL A,"a ; Must uppercasify. CAILE A,"z CAIA SUBI A,40 CAIN A,"T ; Temporary file? JRST [ SETOM $FTEMP(C) JRST TRFD2] CAIN A,"A ; Account? JRST [ MOVEI D,$FACCT ; Set index, and JRST TRFD4] ; go gobble following word. CAIN A,"P ; Protection? JRST [ MOVEI D,$FPROT ; Set index, and JRST TRFD4] ; go gobble following word. TLO FF,FLUNRD ; Not alpha, try numeric. Re-read char, PUSHJ P,TRFDNM ; trying to parse as number. MOVEM B,$FVERS(F) ; Win, parsed as number! Store it. JRST TRFD1] ; If none of above, ignore ";" entirely. PUSHJ P,TRFDW ; Let's try reading it as word, JUMPLE C,APOPJ ; If nothing read, assume it's some terminating delimiter. CAIN A,": ; Else have something, check trailing delim for special cases JRST [ MOVEI D,$FDEV ; Aha, a device. PUSHJ P,RCH ; Flush the terminator & get next char. TRNN FF,FRFDIR ; Unless dir was explicitly given, SETZM $FDIR(F) ; zap furnished default. 0 uses connected dir. TRO FF,FRFDEV ; Say device was explicitly given, and JRST TRFD6] ; store name away. MOVEI D,$FNAME ; Else assume it's the filename. JRST TRFD6 TRFD4: PUSHJ P,RCH ; Here when must gobble next char, TRFD5: PUSHJ P,TRFDW ; here when first char of wd already read. TRFD6: PUSHJ P,FNCHKZ ; Note this can return and store a null string! ADDI D,(F) ; Get address (filblk+index), and MOVEM A,(D) ; store string pointer in the appropriate place. TRO FF,FRNNUL ; Say non-null spec seen, JRST TRFD1 ; and go re-read the delimiter, to process it. ; TRFDW - Read a word (string), for use by TNXRFD. Copies sequence of ; acceptable filename chars into FNBUF, until non-valid char seen. ; A/ First char of word, ; Returns A/ delimiting char, C/ count of chars in string, ; clobbers nothing else. TRFDW4: SUBI A,40 ; Make lowercase TRFDW5: IDPB A,FNBWP ; Deposit into FNBUF, PUSHJ P,RCH ; get next char, AOSA C ; and bump count, skipping over zap instruction. TRFDW: SETZ C, ; When called, zero cnt of chars in string. CAIL A,"A ; See if char is uppercase alpha, CAILE A,"Z CAIA JRST TRFDW5 CAIL A,"a ; or lowercase alpha, CAILE A,"z CAIA JRST TRFDW4 CAIL A,"0 ; or numeric, CAILE A,"9 CAIA JRST TRFDW5 CAIE A,"$ ; or dollarsign CAIN A,"- ; or hyphen JRST TRFDW5 CAIN A,"_ ; Backarrow is special case, because JRST [ TRNN FF,FRCMND ; if reading command, TLNN FF,FL20X ; or running on 10X, POPJ P, ; must treat as delimiter. JRST TRFDW5] CAIN A,^V ; ^V is quote char... JRST [ PUSHJ P,RCH ; Quote, get next. CAIE A,^M ; Quote anything but this. CAIN A,0 ; or this. POPJ P, ; time to exit. PUSH P,A ; Quote it! Save char, MOVEI A,^V ; so that a quoter can precede it. IDPB A,FNBWP ; Fortunately this hair POP P,A ; only needs care IDPB A,FNBWP ; for quoted chars, which are JRST TRFDW5] ; rare. TLNE FF,FL20X ; Are we on a 10X? POPJ P, ; If not, anything at this point is delimiter. CAIL A,41 ; Check general bounds CAIL A,137 ; Range from space to _ exclusive. POPJ P, ; If outside that, delimiter. CAIL A,72 ; This range includes :, ;, <, =, > CAILE A,76 CAIA POPJ P, ; delimiter. CAIE A,". CAIN A,", POPJ P, CAIE A,"* CAIN A,"@ POPJ P, ; Finally, check out chars which are acceptable to 10X but which ; might be delimiter in cmd line... TRNN FF,FRCMND JRST TRFDW5 ; Not hacking cmd line, it's an OK char. CAIE A,"/ CAIN A,"( POPJ P, CAIN A,"! POPJ P, JRST TRFDW5 ; at long last done. ; TRFDNM - Read numerical string, halt when non-digit ; seen, leaves result (decimal) in B, with delimiting char in A. ; One peculiarity is skip return if no numerical char is seen at all; ; else doesn't skip and B has a valid number. TRFDNM: PUSHJ P,RCH ; First char needs special check. CAIL A,"0 CAILE A,"9 JRST POPJ1 ; Not a number at all? TDZA B,B TRFDN2: IMULI B,10. ADDI B,-"0(A) ; Convert to number PUSHJ P,RCH ; Get following chars. CAIL A,"0 CAILE A,"9 POPJ P, ; Nope, not digit so treat as delimiter. JRST TRFDN2 ; Yep, a number ] ;IFN TNXSW IFN TNXSW,[ ; TYPFB - Type out FB pointed to by F TYPFB: SKIPE B,$FDEV(F) ; First, device name? JRST [ PUSHJ P,TYPZ MOVEI A,": PUSHJ P,TYOERR JRST .+1] SKIPE B,$FDIR(F) ; Directory? JRST [ MOVEI A,"< PUSHJ P,TYOERR PUSHJ P,TYPZ MOVEI A,"> PUSHJ P,TYOERR JRST .+1] SKIPE B,$FNAME(F) PUSHJ P,TYPZ MOVEI A,". PUSHJ P,TYOERR SKIPE B,$FEXT(F) PUSHJ P,TYPZ MOVEI A,". ; 20X uses "." to set off version, TLNN FF,FL20X ; but 10X uses ";". MOVEI A,"; PUSHJ P,TYOERR HRRE A,$FVERS(F) JUMPL A,[MOVM B,A ; Is possible to have -1, -2, etc. MOVEI A,"- PUSHJ P,TYOERR MOVE A,B JRST .+1] PUSHJ P,DPNT ; Version # output in decimal. SKIPE $FTEMP(F) TYPE ";T" ; May be temporary. SKIPE B,$FPROT(F) JRST [ TYPE ";P" PUSHJ P,TYPZ JRST .+1] SKIPE B,$FACCT(F) JRST [ TYPE ";A" PUSHJ P,TYPZ JRST .+1] POPJ P, ; Takes BP in B, outputs to TYOERR until zero byte seen. TYPZ: CAIA PUSHJ P,TYOERR ILDB A,B JUMPN A,TYPZ+1 POPJ P, ] ; IFN TNXSW SUBTTL TENEX misc. Filename Routines, FS string storage IFN TNXSW,[ .SEE FSDSK ; Part of this page is NOT conditionalized!! ; To handle filenames of ASCIZ strings instead of SIXBIT words, each ; word has instead a byte pointer to an ASCIZ string. For purposes of ; easy comparison, all of these bp's point into FNBUF, and a routine ; (FNCHK) is provided which checks a just-stored string and returns a bp ; to either this string, if unique, or to a previously stored string if ; it is the same as the one just stored (which is then flushed). Thus ; strings can be compared for equality simply by a comparison of their ; byte pointers. While not necessary, strings are stored beginning on ; word boundaries for easier hacking. ; <# files>**+<# wds for constants> LFNBUF==*5*3+20 ; Enough to hold strings for all output files, ; all translated files, and all .insrt files encountered. ; Later a GC'er can be hacked up so that of the latter only ; enough for the max .insrt level need be allocated. LVAR FNBUF: BLOCK LFNBUF ; Macro to easily define constant strings for comparison purposes DEFINE DEFSTR *STR* 440700,,%%FNLC %%LSAV==. LOC %%FNLC ASCIZ STR %%FNLC==. LOC %%LSAV TERMIN %%FNLC==FNBUF ] ; IFN TNXSW!!! ; If not assembling for TENEX, the following strings become ; simple SIXBIT values. This makes it possible to write simple ; code to work for both TENEX and non-TENEX without messy conditionals. IFE TNXSW,[EQUALS DEFSTR,SIXBIT] FSDSK: DEFSTR /DSK/ ; This stuff defines various BP's into FNBUF to FSSYS: DEFSTR /SYS/ ; use for comparison purposes later. FSTTY: DEFSTR /TTY/ FSNUL: DEFSTR /NUL/ FSPTP: DEFSTR /PTP/ FSATSN: DEFSTR /@/ FSSBSY: DEFSTR /SUBSYS/ FSPROG: DEFSTR /PROG/ FSMID: DEFSTR /MID/ FSMDAS: DEFSTR /MIDAS/ FSGRTN: DEFSTR />/ FSCRF: DEFSTR /CRF/ FSCREF: DEFSTR /CREF/ FSERR: DEFSTR /ERR/ FSLST: DEFSTR /LST/ FSLIST: DEFSTR /LIST/ FSSAV: DEFSTR /SAV/ FSEXE: DEFSTR /EXE/ IFN TNXSW,[ VBLK FNBBP: 440700,,FNBUF ; Points to beg of FNBUF (hook for dynamic alloc) FNBEP: FNBUF+LFNBUF-1 ; Points to last wd in FNBUF (address, not BP) FNBWP: 440700,,%%FNLC ; Write Pointer into FNBUF. FNBLWP: 440700,,%%FNLC ; Last Write Pointer, points to beg of string being stored PBLK EXPUNG %%FNLC ; NOTE - provided MIDAS never restarts, no initialization is necessary to ; start using FNCHK. (Unless of course FNBUF is dynamically allocated someday) ; FNCHK - Check out just-stored filename. Returns BP in A to ASCIZ string, ; which will be "canonical" for comparison purposes. ; Clobbers A,B,T,TT,AA ; FNCHKZ - Makes sure just-writ string is ASCIZ'd out before FNCHK'ing. FNCHKZ: MOVE B,FNBWP ; Get write ptr, LDB A,B ; see if last char was 0, JUMPE A,FNCHK0 ; if so can skip one clobberage. SETZ A, IDPB A,B ; zero out bytes, FNCHK0: TLNE B,760000 ; until at end of word. JRST .-2 ADD B,[<440700,,1>-<010700,,>] ; bump BP to point canonically at next. MOVEM B,FNBWP FNCHK: HRRZ B,FNBWP ; See if write ptr CAML B,FNBEP ; has hit end of FNBUF, and ETF [ASCIZ /Filename buffer overflow/] ; barf horribly if so. MOVE A,FNBBP ; A - bp to start of existing string MOVE AA,FNBLWP ; AA - bp to start of new string to store FNCHK2: MOVEI T,(A) ; T - current addr being checked, existing str MOVEI TT,(AA) ; TT - current addr, new str CAIL T,(TT) ; If addrs are same, or overran somehow, JRST [ MOVE A,AA ; didn't find any match, accept new string. MOVE B,FNBWP MOVEM B,FNBLWP ; Set up new last-write-ptr POPJ P,] FNCHK3: MOVE B,(T) CAMN B,(TT) ; Compare strings, full word swoops. JRST [ TRNE B,377 ; equal, last char zero? AOJA T,[AOJA TT,FNCHK3] ; no, continue for whole string ; Found it! Flush just-stored string, don't want duplicate. MOVEM AA,FNBWP ; Clobber write ptr to previous value. POPJ P,] ; Not equal, move to next string to compare MOVEI B,377 ; Check for ASCIZ, TDNE B,(T) ; moving to end of current string AOJA T,.-1 HRRI A,1(T) ; and updating BP to point at new string. JRST FNCHK2 ; (T gets pointed there too at FNCHK2). ; JFNSTR - Get filename strings for active JFN. ; A/ active JFN ; F/ addr of filename block to clobber. ; JFNSTB - Same, but ignores A and assumes JFN is already stored in block. ; Clobbers A,C JFNSTB: SKIPA A,$FJFN(F) ; JFNSTB gets the JFN from block itself. JFNSTR: MOVEM A,$FJFN(F) ; whereas JFNSTR stores it there... MOVSI D,-NJSTRF ; Set up aobjn thru table. JFNST2: PUSH P,T SYSCAL JFNS,[FNBWP ? $FJFN(F) ? JSTRFX+1(D)][FNBWP] POP P,T MOVE C,JSTRFX(D) ; Now get index to place it belongs in file block, CAIN C,$FVERS ; and check for this, because JRST [ MOVE A,FNBLWP ; it wants to be a number, not a string. MOVEM A,FNBWP ; Zap write pointer back to forget string, PUSHJ P,CVSDEC ; and quickly convert before anything clobbers it. JRST .+2] ; Skip over the FNCHKZ call. PUSHJ P,FNCHKZ ; Fix it up, and get BP to it. ADDI C,(F) ; make it an addr, and MOVEM A,(C) ; store BP. (or value, for $FVERS) ADDI D,1 AOBJN D,JFNST2 POPJ P, ; Filblk idx, output format wd for JFNS call JSTRFX: $FDEV ? 100000,, $FDIR ? 010000,, $FNAME ? 001000,, $FTYPE ? 000100,, $FVERS ? 000010,, NJSTRF==<.-JSTRFX>/2 ; CVSDEC - Converts ASCIZ string to decimal, assumes only digits seen. ; A/ BP to ASCIZ ; Returns value in A, clobbers nothing else. CVSDEC: PUSH P,B PUSH P,C MOVE C,A SETZ A, JRST CVSDC3 CVSDC2: IMULI A,10. ADDI A,-"0(B) CVSDC3: ILDB B,C JUMPN B,CVSDC2 POP P,C POP P,B POPJ P, ; CVSSIX - Converts ASCIZ string to SIXBIT word. ; A/ BP to ASCIZ string, ; Returns SIXBIT word in A. Clobbers nothing else. CVSSIX: PUSH P,B PUSH P,C PUSH P,D MOVE D,A SETZ A, MOVE B,[440600,,A] JRST CVSSX3 CVSSX2: CAIL C,140 SUBI C,40 ; Uppercase force SUBI C,40 ; cvt to 6bit IDPB C,B ; deposit TLNN B,770000 ; If BP at end of word, JRST CVSSX5 ; leave loop. CVSSX3: ILDB C,D JUMPN C,CVSSX2 CVSSX5: POP P,D POP P,C POP P,B POPJ P, ; CV6STR - Takes 6bit word in A, writes into FNBUF and makes a string of ; it, returning BP in A. ; Clobbers A,B,T,TT,AA (due to FHCHKZ) CV6STR: MOVE B,A CV6ST2: SETZ A, LSHC A,6 ; Get a 6bit char ADDI A,40 ; Make ASCII IDPB A,FNBWP ; deposit JUMPN B,CV6ST2 ; Continue until nothing left PJRST FNCHKZ ; Make output thus far a string. ; CVFSIX - Takes current filblk (pointed to by F) and puts the ; right stuff in $F6 entries. CVFSIX: PUSH P,A PUSH P,B MOVSI B,-L$F6BL CVFSX2: MOVE A,@CVFTAB(B) ; Get BP to string PUSHJ P,CVSSIX ; Convert to 6bit ADDI B,$F6DEV(F) ; Get index to right place to store. MOVEM A,(B) SUBI B,$F6DEV(F) ; restore aobjn pointer... AOBJN B,CVFSX2 POP P,B POP P,A POPJ P, CVFTAB: $FDEV(F) $FNAME(F) $FEXT(F) $FDIR(F) IFN <.-CVFTAB>-L$F6BL, .ERR CVFTAB loses. ] ; IFN TNXSW SUBTTL DEC/TENEX - RUN hacking. (Process FOO! in CCL) IFN DECSW,[ ; Process "FOO!", which means "run SYS:FOO with an offset of 1". ; Note that the RUN call needs a block of 6 ACs, but at this point ; it doesn't matter what gets clobbered. ; Entry point for restart, from TSRETN. RERUN: MOVE B,FSMDAS ; Get name - using SYS:MIDAS SETZB C,D+1 ; (no ext or ppn) JRST RFDRU1 VBLK RFDRUN: MOVE A,$F6DEV(F) ; Load up the 4 filenames to use. MOVE B,$F6FNM(F) MOVE C,$F6EXT(F) MOVE D+1,$F6DIR(F) JUMPN A,RFDRU3 ; If device specified, use that, MOVSI A,'DSK ; else default to DSK CAIN D+1, ; if a PPN was given, and RFDRU1: MOVSI A,'SYS ; to SYS: otherwise. RFDRU3: SETZB D,D+2 ; These acs must always be zero... MOVEI D+3,177 ; Flush all core above this address. IFN SAILSW,[ SETZ D+4, CORE2 D+4, ; Flush hiseg by hand on SAIL. HALT ] .ELSE HRLI D+3,1 ; Elsewhere, just set LH to this to flush hiseg. MOVE D+4,[RUNCOD,,D+5] ; Move core-less code into position in ACs. BLT D+4,+LRUNCD-1 MOVE D+4,[1,,A] ; ,,
JRST D+5 ; Go flush core and run program. RUNCOD: CORE D+3, ; Flush as much core as possible; RUN uuo can lose HALT ; Because of how much we have. RUN D+4, HALT LRUNCD==.-RUNCOD ; Make sure symbols A-D leave enuf room. IFL 17-, .ERR RFDRUN ACs lose. PBLK ] ;END IFN DECSW IFN TNXSW,[ ; On TENEX, we'll do things without compat package (boo hiss) ; Entry point for starting new MIDAS, come here from TSRETN. RERUN: MOVEI F,FB BLTZ L$FBLK,FB ; Clear out scratch filblk, point at it. MOVE A,FSMDAS ; Get BP to "MIDAS", store in MOVEM A,$FNAME(F) ; filblk, and drop thru for defaults. ; Here to start up specified program, for CCL hacking. RFDRUN: TLNN FF,FL20X ; 20X or Tenex? JRST [ MOVE A,FSSBSY ; Tenex, get BP to SUBSYS string SKIPN $FDIR(F) ; Unless directory specified, MOVEM A,$FDIR(F) ; default dir to . MOVE A,FSSAV ; And do similar thing for ext (.SAV) JRST RFDRN2] MOVE A,FSSYS ; 20X, get BP to SYS string SKIPN $FDEV(F) ; Unless device specified, MOVEM A,$FDEV(F) ; default dev to SYS:. MOVE A,FSEXE ; And ditto for ext (.EXE) RFDRN2: SKIPN $FEXT(F) ; If extension not specified, MOVEM A,$FEXT(F) ; Store appropriate one. PUSHJ P,GETJFI ; Get JFN for input... HALT ; Ugh, bletch, etc. ; OK, all ready to smash ACs with loader, etc. MOVE R1,$FJFN(F) ; Put JFN into RH HRLI R1,.FHSLF ; and fork handle (self) in LH. MOVE R2,[RUNCOD,,R3] ; Load into ACs beginning at AC 3 BLT R2,R3+LRUNCD-1 JRST R3 ; Off we go, never to return... ; Following code is executed in AC's, position independent. RUNCOD: GET ; Load up the file. MOVEI R1,.FHSLF GEVEC ; Find entry vector word for it, returned in AC 2. JRST R1(R2) ; and go execute instruction in reenter slot. LRUNCD==.-RUNCOD ; Pretty small loader, huh? ] ; IFN TNXSW SUBTTL Core Allocation routine - GCCORQ gets another K for MACTAB ; Get another K of MACTAB space. GCCORQ: MOVE A,MACHI LSH A,-2 ; Convert to word # CAIL A,MXMACL ; Want more than allowed? POPJ P, MOVE A,MACTND ; No, get addr of block we want to get. PUSH P,A ; Entry, save A in case have to try again CORRQ1: IFN ITSSW,[ LSH A,-10. SYSCAL CORBLK,[MOVEI %CBNDR+%CBNDW MOVEI %JSELF ? A ? MOVEI %JSNEW] JRST CORRQL ; Lose ] IFN DECSW,[ IORI A,1777 CORE A, JRST CORRQL ; Lose ] IFN TNXSW,[ SKIPN MEMDBG ; Only need to hack if want. JRST CORRQ3 ; Super kludge. No way to ask 10X for a "new page"; must ; get it via default create-on-reference. Hence to get page ; without bombing, must be sure .ICNXP interrupt deactivated! PUSH P,T SYSCAL DIC,[[.FHSLF] ? [1_<35.-.ICNXP>]] ; Deactivate. SETZM (A) ; Reference 1st page SETZM 1000(A) ; Reference 2nd page. SYSCAL AIC,[[.FHSLF] ? [1_<35.-.ICNXP>]] ; Re-activate. POP P,T CORRQ3: ] REST A ADDI A,2000 JRST MACIN2 ; Update pointers to end of MACTAB. IFN ITSSW\DECSW,[ ; Lossage handler for GCCORQ. Only ITS or DEC can fail. CORRQL: PUSH P,C PUSH P,D TLOE AA,400000 JRST CORQL1 TYPE " No core for macro table." CORQL1: TYPE " Try again? " CORQL2: PUSHJ P,TYI ; Get char CAIL A,140 ; Cheap uppercase force SUBI A,40 CAIN A,"Y ; Y, JRST CORRQA ; => try again CAIN A,"N ; N, JRST CORRQB ; => back to DDT then try again CAIN A,"? ; ?, ERJ CORQL1 ; => type out error-type blurb TYPE "? " ; something else JRST CORQL2 CORRQB: IFN ITSSW,.VALUE ; Loop point for don't-proceed IFN DECSW,EXIT 1, TLZ AA,400000 CORRQA: POP P,D POP P,C MOVE A,(P) ; Restore A from PDL JRST CORRQ1 ] ; IFN ITSSW\DECSW SUBTTL Core allocation - TENEX routine to get pages (TCORGT) IFN TNXSW,[ ; TCORGT - Takes arg in AA, an ITS page AOBJN to pages to grab. ; Clobbers no ACs but AA. TCORGT: JUMPGE AA,APOPJ ; Ignore arg if nothing to do about it. SKIPN MEMDBG ; Ignore anyway if not hacking memory POPJ P, PUSH P,R1 PUSH P,R2 PUSH P,R3 MOVE R3,AA ASH R3,1 ; Get Tenex page AOBJN MOVEI R1,(R3) LSH R1,9. ; Get word address of first page. HRR R3,R1 ; Stick back in AOBJN. ; Super kludge. No way to ask 10X for a "new page"; must ; get it via default create-on-reference. Hence to get page ; without bombing, must be sure .ICNXP interrupt deactivated! MOVEI R1,.FHSLF MOVE R2,[1_<35.-.ICNXP>] DIC ; Deactivate. TCORG3: SETZM (R3) ; Get the page. ADDI R3,777 ; Bump word address, AOBJN R3,TCORG3 ; and get next page (note adds 1 more to RH) AIC ; Now re-activate... POP P,R3 POP P,R2 POP P,R1 POPJ P, ] ;IFN TNXSW