Trailing-Edge
-
PDP-10 Archives
-
mit_emacs_170_teco_1220
-
emacs/tsrtns.mid
There are 2 other files named tsrtns.mid in the archive. Click here to see a list.
;-*-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.
IFNDEF NINBFS,NINBFS==2 ; # standard-size buffers to use for input.
IFNDEF UTIBFL,UTIBFL==<DECBFL+1>*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 <desired JFN>,,<temp JFN>)
]
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 <subindex>,,<table #>
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 ; <dec-mode> 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 <ch>,<header> 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 - <mode> <ch>,<filblk>
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 <mode>,,<ch>
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 <filblk>
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 <filblk>
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 <size in bytes>,,<buffer addr>-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 <mode> <ch>,<filblk>
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,[<OPEN A>#<OUTBUF 1>] ; Request buffer setup (one of)
XCT TT
REST .JBFF
MOVE A,[SIXBIT /000MD /]
PJOB B, ; Get job number, to make sixbit /<nnn>md<e, o, or l>/
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,[<OUTBUF 1>#<ENTER A>]
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 <filblk>
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#<RENAME A>]
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#<GETSTS A>]
XCT C ; Read file status.
TRZ A,74^4 ; Clear error bits.
ETR [ASCIZ /Output data error/]
XOR C,[<GETSTS A>#<SETSTS (A)>]
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: <mode> <ch>,<filblk> ; <mode> is 0 for ascii, 13^9 for bin.
; 2: sixbit /<desired temp fn2>/
; 3: <header>,,<buffer-space>
; <return to this location>
; 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 <header>,
SETOM 2(A) ; and set buffer byte cnt to -1 to mark for init.
MOVE F,(C) ; Get <mode> <ch>,<filblk>
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 <mode>
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(<LERSTR+4>/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 <ch>,,<header>
; 2: <filblk>
; 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 <filblk>. <ch>
; is ignored except to wipe out its JFNCHS entry.
OCLOSE: PUSH P,A
MOVE C,(A) ; Get <ch>,,<header>
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 <filblk>
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
JRST OCLOS6 ; JFN in A released by RNAMF.
OCLOS5: SYSCAL RLJFN,[A]
HALT
OCLOS6: SETZM $FJFN(F)
POP P,A
JRST 2(A)
; OBUFO - Output Buffer and reinitialize.
; C/ 0 <ch>,<header>
; Clobbers no ACs.
; 10X is pretty much like ITS, JFN is kept in JFNCHS table indexed by <ch>.
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 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,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,[<GETSTS B>#IN]
XCT A
TRZE B,74^4
ETR [ASCIZ /Input data error/]
XOR A,[<GETSTS B>#<SETSTS (B)>]
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/ <mode>
; B/ <device name in 6bit>
; C/ <header addr>
; D/ <buffer space addr>
; 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/ <filblk> 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/ <flags>,,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...
ADDI A,1 ; And another for the final slurp (even if it will be empty)
MOVNM A,INPGCT ; Store -# slurps.
MOVEI A,777(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.
JUMPE R3,INCH51 ; if an exact number of pages before, no new mapping
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 INCH51 ; Yep, done with manual iteration.
ADDI R2,1 ; Nope, bump page #'s.
AOJA R1,INCH50]
INCH51:
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 <filedescription><CR> ; 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 <filedescription><CR> ; 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>,,<page #> and flush these pages.
DELPGS: PUSH P,A
PUSH P,B
HLRZ B,A
HRLI A,.FHSLF ; <fork>,,<page #>
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,R1
IFE R1-A,.ERR IOPDLC WONT WORK WITH A=1
IFN PMAPSW,[
MOVEI R1,1STBFP ; Reset to point at 1st page of buffer space.
MOVEM R1,INBFPG
]
EXCH A,IOPDLP
JRST IOPDC3
IOPDC2: MOVE R1,(A)
CAME R1,ISFB+$FJFN ; Dont close main input file
CLOSF
JFCL
SUB A,[1,,1]
IOPDC3: CAMLE A,[-LIOPDL,,$IOPDL-1]
JRST IOPDC2
EXCH A,IOPDLP
POP P,R1
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.
TTYOPF: 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 TTYOPF
CALL TTYINI
.IOT TYOC,A
POPJ P,
; TYI - Get (just typed in) char in A
TYI: SKIPN TTYOPF
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 TTYOPF ; 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 TTYOPF
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 TTYOPF
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 TTYOPF ; 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,.CTTRM ; 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 TTYOPF
CALL TTYINI
OUTCHR A
POPJ P,
; TYI - Get a typed-in char in A
TYI: SKIPN TTYOPF ; 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 TTYOPF
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,, ? -<CMBFL-1>,,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,[-<CMBFL-1>,,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 <addr of instr to xct if file spec'd>,,<filblk ptr>
; 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>*<avg # strings/file>*<avg # words/string>+<# wds for constants>
LFNBUF==<MAXIND+5>*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,<D+5>+LRUNCD-1
MOVE D+4,[1,,A] ; <start offset>,,<address of arg block>
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-<D+5+LRUNCD>, .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 <SUBSYS>.
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