ߋt v
?B-NO BOOT ON VOLUME
@w p@w
w P
w
f &
fw W# w v
@
@w P
@&
7
"
BLOCK @ IS BAD
- ̂@ &
#
p@ zw
7
P7
R & B g w D
ѕ
Rì
s
p x]
\ Z 1
d
s
- 2 &w* & #kQ . y%kQ'
. U dkQ . t^ kQN . ?kQ
. @kQ . AkQ
. BkQ . kQ . kQ%
. THE STRING WHICH WAS IN [] ON THE INPUT SIDE OF THE
; COMMAND
; R2 -> FILNAM.EXT IN ASCII, TERMINATED BY A 0 BYTE OR A /
; R3 -> DEV:FILNAM.EXT IN RAD50 FOR INPUT SIDE
; R4 = WILD CARD FLAG: BOTTOM BYTE NEGATIVE IF * NAME
; TOP BYTE NEGATIVE IF * EXTENSION
; R5 -> FREE CORE, INITIALLY CONTAINS DSTATUS FOR DEV:
; FUNCTION:
; SCAN OFF DATA IN [], IF RELEVANT
; VERIFY DEVICE TYPE
; FETCH HANDLER @R5
; EXPAND INPUT FILENAME OR WILD-CARD CONSTRUCTION INTO A LIST
; OF BLOCKS IN THE FREE AREA (AFTER THE HANDLER).
; EACH BLOCK IS 8 WORDS LONG, AND MUST CONTAIN THE
; FILENAME.EXT IN RAD50 IN THE FIRST 3 WORDS.
; WORDS 4-8 ARE KNOWN AS THE 'SAVBLK' FOR THE FILE.
; FOR A TRANSFER OPERATION, WORDS 4-8 MAY CONTAIN ANY
; INFORMATION NECESSARY FOR THE ASSOCIATED I/O ROUTINES
; TO FIND AND READ THE FILE. HOWEVER, WORD 6 IS EXPECTED
; TO CONTAIN THE FILE SIZE (IN RT-11 BLOCKS, I.E.
; 256. WORDS/BLOCK, 2 CHARACTERS/WORD) SO THAT AN
; APPROPRIATE ENTER CAN BE DONE. IF A DIRECTORY LIST IS
; BEING DONE (SWT.L <> 0), THE DATE MUST BE AVAILABLE.
; IF THE I/O ROUTINES NEED A FIXED BUFFER, IT MAY BE ALLOCATED
; FROM FREE CORE AT THIS TIME.
; RETURNS:
; R3 -> BLOCK LIST, ENDING IN A 0 WORD
; R5 -> NEW FREE CORE
; MAY DESTROY: R0,R1,R2,R4
;**********************************************************************
; OPEN - PREPARE FOR OUTPUT ON A DEVICE
; CALLED WITH:
; R2 -> DEV:FILNAM.EXT IN RAD50 FOR OUTPUT SIDE (MAY HAVE *'S)
; R3 -> EXPANDED INPUT LIST (SEE ABOVE)
; R5 -> FREE CORE, INITIALLY CONTAINS DSTATUS FOR DEV:
; FUNCTION:
; VERIFY DEVICE TYPE
; FETCH HANDLER @R5
; ALLOCATE ANY FIXED BUFFERS FROM FREE CORE OR BY LOWERING
; CORTOP
; READ DIRECTORY FOR OUTPUT EXPANDER INTO FIXED BUFFER IF NEEDED
; PRE-DELETE FILES OR CHECK FOR EXISTING FILES USING INPUT LIST
; RETURNS:
; R5 -> NEW FREE CORE
; MAY DESTROY: R0,R1,R2,R4
;**********************************************************************
; LKUP - PREPARE TO READ FILE
; CALLED WITH:
; R3 -> SAVBLK FOR FILE
; FUNCTION:
; SET UP ANY INTERNAL ROUTINES TO READ FROM THE DESIGNATED FILE.
; PRIME FIXED INPUT BUFFER, IF DESIRED, OR JUST CONDITION
; READ TO START AT BEGINNING OF FILE.
; MAY MODIFY SAVBLK IF NEEDED.
; MAY DESTROY: R0,R1,R2,R4,R5
;**********************************************************************
; ENTER - PREPARE TO WRITE FILE
; CALLED WITH:
; R2 -> DEV:FILNAM.EXT[LEN] IN RAD50 (FROM CSI)
; R3 -> INPUT FILNAM.EXT/SAVBLK
; FUNCTION:
; ENTERS FILE ON OUTPUT DEVICE.
; MUST EXPAND ANY *.* CONSTRUCTION IN OUTPUT NAME WITH OEXPND.
; (NOTE: LKUP ROUTINE HAS NOT YET BEEN CALLED)
; RT-11 VALUE FOR FILE LENGTH IS AVAILABLE AT 8.(R3)
; MAY DESTROY: R0,R1,R4,R5
;**********************************************************************
; READ - READ BUFFER LOAD OF DATA
; CALLED WITH:
; R3 -> SAVBLK
; R4 -> INPUT BUFFER (INBUFF)
; R5 -> TOP OF INPUT BUFFER (INBUFE)
; FUNCTION:
; READ AS MUCH DATA AS POSSIBLE INTO INPUT BUFFER.
; THE INPUT BUFFER SIZE IN BLOCK IS AVAILABLE AT BUFSIZ.
; IF EOF ENCOUNTERED, MAY RETURN SHORT BUFFER.
; THIS ROUTINE WILL BE RE-CALLED UNTIL IT RETURNS A NULL
; BUFFER TO SIGNAL END OF FILE.
; IT NEED NOT WORRY ABOUT DELETING NULLS & RUBOUTS.
; RETURNS:
; R4 -> TOP OF AREA ACTUALLY READ (UNCHANGED IF EOF)
; MAY DESTROY: R0,R1,R2
;**********************************************************************
; WRITE - WRITE A BUFFER LOAD
; CALLED WITH:
; R4 -> OUTPUT BUFFER (OUBUFF)
; R5 -> TOP OF DATA TO BE OUTPUT (VARIES ACCORDING TO AMT READ)
; FUNCTION:
; OUTPUT BUFFER LOAD TO OUTPUT FILE
; WRITE WILL NEVER BE CALLED TO OUTPUT A NULL BUFFER, BUT MAY
; BE CALLED WITH A SHORT BUFFER. IT MUST COMPUTE ITS OWN WORD
; COUNT. THE SIZE IS ALWAYS AN EXACT NUMBER OF BLOCKS, EXCEPT
; FOR THE LAST CALL, WHICH MAY BE SHORT.
; MAY DESTROY: R0,R1,R2
;**********************************************************************
; CLOSE - CLOSE OUTPUT FILE
; NO ARGUMENTS
; FUNCTION:
; CLOSE CURRENT OUTPUT FILE, FLUSHING INTERMEDIATE BUFFERS
; IF NEEDED. UPDATE DIRECTORY, MAKING FILE PERMANENT.
; MAY DESTROY: R0,R1,R2,R4,R5
;**********************************************************************
; DIR - GET DATE
; CALLED WITH:
; R3 -> SAVBLK
; FUNCTION:
; RETURN DATE OF SELECTED FILE IN RT-11 FORMAT, BUT RELATIVE
; TO 1964.
; RETURNS:
; R0 = DATE
; MAY DESTROY: R1,R2
.SBTTL MACRO DEFINITIONS
; CSECTS FOR ERROR TABLES (OCCUR FIRST)
.CSECT ERRMSG ;THIS CSECT CONTAINS THE MESSAGE TEXTS
.CSECT ERRTBL ;THIS CSECT CONTAINS MESSAGE POINTERS
ERRTBL: ;DEFINE BASE OF ERROR TABLE
.CSECT MAIN$ ;THE MAIN BODY
; SYSTEM MACROS
.MCALL ..V1..
..V1..
.MCALL .CLOSE, .CSISPC,.DATE, .DSTATU,.EXIT, .FETCH
.MCALL .LOCK, .LOOKUP, .MTPS,.PRINT, .QSET, .RCTRLO,.READW, .REOPEN ;###
.MCALL .SAVEST,.SETTOP,.SRESET,.TTYIN, .TTYOUT,.UNLOCK,.WAIT
.MCALL .WRITE, .WRITW
; CALL AND RETURN MACROS
.MACRO CALL ARG
JSR PC,ARG
.ENDM CALL
.MACRO RETURN
RTS PC
.ENDM RETURN
; MACRO TO REPEAT ITS ARGUMENT MACRO FOR EACH FUNCTION NAME
.MACRO LIST MAC,ARG2
.IRP ARG,
.IF NB ARG2
MAC ARG,ARG2
.IFF
MAC ARG
.ENDC
.ENDR
.ENDM LIST
; MACRO FOR LIST TO GEN DISPATCH TABLE
.MACRO DISPATCH ARG,L
.WORD L'.'ARG
.ENDM DISPATCH
; MACRO FOR LIST TO GENERATE OFFSETS
.MACRO OFFSET ARG
$'ARG= 2*GOTOSZ
GOTOSZ= GOTOSZ+1
.ENDM OFFSET
GOTOSZ=0
; MACRO FOR LIST TO GENERATE NOT-IMPL DEFINES
.MACRO NOTIMP ARG,L
.IF NDF L'.'ARG
L'.'ARG:
.ENDC
.ENDM NOTIMP
LIST OFFSET
; MACROS TO GENERATE CALLS TO STRUCTURE ROUTINES
.MACRO ICALL RTN
JSR PC,@INGOTO+$'RTN
.ENDM ICALL
.MACRO OCALL RTN
JSR PC,@OUGOTO+$'RTN
.ENDM OCALL
; MACRO TO GENERATE ERROR CALL.
; ALSO GENERATES MESSAGE IN TABLE IF 2ND ARG IS PRESENT
.MACRO ERR CODE,MSG
.NLIST
.IF NB
.CSECT ERRMSG
LAB=.
.ASCIZ /?MSG?/
.CSECT ERRTBL
CODE=.-ERRTBL
.WORD LAB
.CSECT MAIN$
.ENDC
.LIST
TRAP CODE
.ENDM ERR
; MACRO TO GENERATE TABLE OF SPECIAL CHARACTERS
; TO BE FOUND IN INPUT STRING
.MACRO SPC C,D
.BYTE C,/2 ;RELATIVE OFFSET
.ENDM SPC
; MACRO TO GENERATE SWITCH TABLE
; FORMAT: SWITCH NAME (1 BYTE)
; DISPATCH LOC'N (1 BYTE)
; WORD FOR VALUE, LABEL SWT.X
; WORD FOR ASSOCIATED CONSTANT
.MACRO SWT L,GO,VAL
.ASCII /L/
.BYTE /2
SWT.'L: .WORD 0
.IF B VAL
.WORD 0
.IFF
.IF IDN GO,ACT
.WORD VAL-ACBASE
.IFF
.WORD VAL
.ENDC
.ENDC
.ENDM SWT
.SBTTL SYMBOL DEFINITIONS
; REGISTERS
R0 = %0
R1 = %1
R2 = %2
R3 = %3
R4 = %4
R5 = %5
SP = %6
PC = %7
PS = 177776
; DECTAPE CONTROLLER ADDRESSES
TCST = 177340 ;STATUS REGISTER
TCCM = 177342 ;COMMAND REGISTER
TCWC = 177344 ;WORD COUNT REGISTER
TCBA = 177346 ;BUS ADDRESS REGISTER
TCDT = 177350 ;DATA REGISTER
; LOW CORE ADDRESSES
STRTAD = 40 ;PROGRAM START ADDRESS
SPINIT = 42 ;LOCATION CONTAINING INITIAL STACK PTR
HICORE = 50 ;LOCATION CONTAINING HIGHEST ADDR OF PROGRAM
ERRLOC = 52 ;ERROR CODE LOCATION
SYSPTR = 54 ;POINTER TO TOP OF RMON (START OF RESIDENT)
JSW = 44 ;JOB STATUS WORD
OFFSET = 266 ;OFFSET TO VITAL RMON WORD!
CONFIG = 300 ;OFFSET TO CONFIGURATION WORD
FJOB$ = 200 ;THIS BIT IN CONFIG MEANS F JOB IS IN
; CODES FOR TRANSFER MODE
ASCII = 2
IMAGE = 4
PACKED = 6
; DIRECTORY BIT CODES
DIREOB = 4000 ;END OF BLOCK
DIRPRM = 2000 ;PERM ENTRY
DIRESZ = 16 ;LENGTH OF ENTRY
DIRBLK = 6 ;STARTING BLOCK OF DIR
R50STAR = 132500 ;ASTERISK FROM CSI
; SET UP TRAP VECTOR FOR ERRORS
.ASECT
.=34 ;WHERE TRAP TRAPS
ERRPRT ;IT WILL GO TO US
0 ;WITH 0 PRIORITY
.CSECT MAIN$ ;BACK TO SHADOWS
.SBTTL FIXED STORAGE AREAS - VOLATILE
OUFDB: .BLKW 4 ;DEV:FILNAM.EXT FOR OUTPUT
ACTION: .WORD 0 ;PUT THINGS TO BE CLEARED HERE
CPYMOD: .WORD 0 ;AND LET THE CSI WORK FOR US
DEFEXT: .WORD 0,0,0,0
; *** CAUTION - NEXT 3 WORDS MUST STAY IN ORDER
R.DEVS: .WORD 0 ;RT-11 DEVICE STATUS
R.CHAN: .WORD 0 ;CURRENT RT-11 CHANNEL
R.NCHA: .WORD 0 ;NUMBER OF OPEN CHANNELS
OUBUFF: .WORD 0 ;LOCATION OF OUTPUT BUFFER
OUSIZE: .WORD 0 ;IT'S SIZE IN WORDS
INFDB: .BLKW 4 ;INPUT DEV:FILNAM.EXT
R.LENG: .WORD 0 ;LENGTH GIVEN IN BRACKETS
S.BLOK: .WORD 0
S.PBLK: .WORD 0
S.BUFF: .WORD 0
INGOTO: .BLKW GOTOSZ ;DISPATCH TABLE
OUGOTO: .BLKW GOTOSZ
.BYTE 0,0,0,0,0,0,0,377 ;BUFFER FOR CONVERSION
DIGITS=.-1
CMDBUF: .BLKB 72. ;INPUT COMMAND STRING
.BLKB 14. ;BRACKETED STUFF
BRKBF1=.
.BLKB 14.
BRKBF2=.
OUASCI: .WORD 0 ;POINTER TO OUTPUT FILE NAME
DATE: .WORD 0 ;POINTER TO SYSTEM DATE
XTRABY: .WORD 0 ;EXTRA BYTES/DIR ENTRY
; NEXT 2 IN ORDER
R.IBLK: .WORD 0 ;BLOCK # FOR INPUT
BUFSIZ: .WORD 0 ;SIZE OF I/O BUFFER (BYTES)
USRBUF: .WORD 0 ;POINTER TO BOTTOM OF USR (TOP OF AVAIL CORE)
CORTOP: .WORD 0 ;TOP OF AVAIL CORE (LOW IF DOS MFBM IN)
INBUFF: .WORD 0 ;POINTER TO INPUT BUFFER
S.BCTR: .WORD 0 ;BYTE COUNTER FOR DOS ASCII XFER
S.BPTR: .WORD 0 ;BUFFER PTR FOR SAME
S.DBUF: .WORD 0 ;POINTS TO USRBUF-3 BLOCKS
S.BMAP: .WORD 0 ;POINTS TO USRBUF-1 BLOCK
S.ZFMT: .WORD 1,104,36.,1,0 ;ZEROED DT FORMAT FOR DOS. BITMAP BLK
.WORD 1,0 ;FILE BITMAPS
.WORD 4,101,4,104,104 ;MFD0
.WORD 4,0 ;MFD1
S.PPDF: .WORD 401,102,9. ; (CONT)
.WORD 1,103 ;UFD0
.WORD 1,0 ;UFD1
.WORD 0 ;END OF LIST
S.FNUM: .WORD 0 ;FILE NUMBER OF DOS OUTPUT FILE
S.FPTR: .WORD 0 ;POINTER INTO DIRECTORY
S.NAME: .WORD 0,0,0 ;NAME IN RAD50
S.DATE: .WORD 0,0 ;TODAY'S DATE (DOS), FILLER
S.FBLK: .WORD 0 ;PTR TO FIRST BLOCK
S.NBLK: .WORD 0 ;NUMBER OF BLOX IN FILE
S.LBLK: .WORD 0 ;LAST BLOCK
.WORD 233 ;PROTECTION
.SBTTL FIXED STORAGE AREAS - NON-VOLATILE
; DISPATCHING TABLES FOR FILE STRUCTURES
R.GOTO: LIST DISPATCH R ;RT-11 TABLES
T.GOTO: LIST DISPATCH T ;TOPS-10 TABLES
S.GOTO: LIST DISPATCH S ;DOS TABLES
; SPECIAL CHARACTERS IN INPUT
SPCL: SPC '[,BRACK ;START OF BRACKETED AREA
SPC 015,CMREAD ;SKIP CR TO GET LINE FEED
SPC 012,CMEND ;LINE FEED ENDS LINE
SPC 054,CMDERR ;COMMA IMPLIES >1 NAME PER SIDE
SPC '=,EQLS ;EQUALS SIGN CHANGES SIDE
SPC '<,LESSGN ;DITTO, CHANGE TO =
SPC ':,COLON ;FIX START OF ASCII NAME
.WORD 0 ;END OF TABLE
; SWITCHES
SWTBL: SWT A,MOD,ASCII ;ASCII MODE TRANSFER
SWT I,MOD,IMAGE ;IMAGE MODE TRANSFER
SWT P,MOD,PACKED ;PACKED MODE TRANFER
SWT S,FIL,S.GOTO ;DOS FILE STRUCTURE
SWT T,TEN,T.GOTO ;TOPS-10 FILE STRUCTURE
SWT C,ACT,COPY ;ACTION = COPY
SWT D,ACT,DELETE ;ACTION = DELETE
SWT L,ACT,LIST ;ACTION = DIRECTORY
SWT Z,ACT,ZERO ;ACTION = ZERO
SWT F,ACT,FASTDI ;ACTION = FAST DIRECTORY
SWT V,ACT,VERSION ;ACTION = TYPE VERSION #
SWT G,IGN ;IGNORE INPUT ERRORS
SWT N,NUM ;(UNUSED)
.WORD 0 ;END OF TABLE
VERMSG: .ASCIZ "FILEX V02-02 " ;###
RUSURE: .ASCII ":/Z ARE YOU SURE ?"<200>
EXISTS: .ASCIZ " ALREADY EXISTS?"
.EVEN
.SBTTL ERROR ROUTINE, SAVREG
; REGISTER SAVE ROUTINE
SAVREG: MOV R2,-(SP) ;A HANDY UTILITY
MOV R3,-(SP)
MOV R4,-(SP)
MOV R5,-(SP)
CALL @R1
MOV (SP)+,R5
MOV (SP)+,R4
MOV (SP)+,R3
MOV (SP)+,R2
MOV (SP)+,R1
RETURN ;RETURN TO HIS CALLER
.ENABL LSB
; VERSION COMMAND
VERSION:MOV #VERMSG,R0
BR 1$
; ERROR MESSAGE HANDLER
ERRPRT: MOV @SP,R0 ;POINT R0 TO TRAP INSTR + 2
MOV -(R0),R0 ;R0 CONTAINS THE TRAP INSTRUCTION
MOV ERRTBL-TRAP(R0),R0 ;R0 NOW POINTS TO MESSAGE
1$: .PRINT
; JMP START ;GO RESTART (RESET STACK)
.DSABL LSB
.SBTTL INITIALIZATION
NOP ;REENTRY NO-OP
START: MOV @#SPINIT,SP ;INITIALIZE STACK POINTER
.RCTRLO ;RESET ^O
.UNLOCK ;RELEASE USR IF WE HAVE IT
CLR OUASCI ;MARK NO OUTPUT FILE GIVEN
.SRESET ;PURGE HANDLERS, GRONK FILES
MOV #SWTBL+2,R0 ;CLEAR SWITCH TABLE
1$: CLR (R0)+ ;CLEAR A WORD
TST (R0)+ ;ADVANCE POINTER
TST (R0)+ ;END OF TABLE?
BNE 1$ ;NOPE
MOV USRBUF,CORTOP ;SET UP TOP OF CORE
.SBTTL COMMAND STRING READER
; READ AND INTERPRET COMMAND STRING, SEPARATINE OUT
; THINGS IN BRACKETS
.TTYOUT #'* ;PROMPT USER WITH STAR
MOV #CMDBUF,R1 ;R1 -> CHARACTER BUFFER
MOV R1,R2 ;R2 = START OF ASCII FILE NAME
MOV #BRKBF1-1,R4 ;R4 -> [] INFO FOR 1ST FILE
CLRB (R4)+ ;ZERO IT INITIALLY
MOV #72.,R3 ;R3 = CHAR COUNTER
CMREAD: .TTYIN ;EAT A CHARACTER
MOV #SPCL,R5 ;TABLE OF SPECIAL CHARACTERS
1$: CMPB R0,(R5)+ ;IS THIS A SPECIAL ?
BNE 2$ ;NO, LOOK AGAIN
MOVB @R5,@PC ;SET UP DISPATCH
BR .+2 ;REL. BRANCH GETS PLUGGED
SPBASE=.
2$: TSTB (R5)+ ;PUSH SPECIAL POINTER
BNE 1$ ;GO IF MORE TO SEE
CMDSTF: MOVB R0,(R1)+ ;STUFF THE BYTE
DEC R3 ;COUNT DOWN
BGT CMREAD ;CONTINUE IF ROOM
CMDER2: .TTYIN ;SKIP TO LINE FEED
CMP R0,#012
BNE CMDER2
CMDERR: ERR ILCM, ;ILLEGAL COMMAND
LESSGN: INC R0 ;CHANGE < TO =
EQLS: MOV #BRKBF2-1,R4 ;SET UP FOR SECOND [] STUFF
CLRB (R4)+
MOV R2,OUASCI ;SAVE POINTER TO OUTPUT FILE NAME
COLON: MOV R1,R2 ;NEW ASCII NAME PTR
INC R2 ; IS AFTER THIS
BR CMDSTF ;STUFF IT
BRACK: TST R4 ;ALREADY HAD A [] ?
BEQ CMDER2 ;BOGUS IF TRUE
MOV #14.,R5 ;ALLOW ROOM FOR PPPPPP,PPPPPP0
1$: .TTYIN ;GET A THING
CMP R0,#015 ;CARRIAGE RTN INSIDE ?
BEQ CMDER2 ; ILLEGAL IF SO
CMP R0,#'] ;END ?
BEQ 2$ ;JA, WUNDERBAR
MOVB R0,-(R4) ;STUFF IN BRACK BUFF
DEC R5 ;OVERFLOWED BUFFER?
BGT 1$ ;NO, KEEP LOOKING
BR CMDER2 ;YES, BOOT HIM
2$: CLRB -(R4) ;MARK END OF BUFFER
CLR R4 ;INDICATE THAT WE FOUND []
BR CMREAD
.SBTTL SWITCH HANDLER
CMEND: CLRB @R1 ;MARK END OF INPUT STRING
MOV #CMDBUF,R1 ;REPOINT TO STRING
TSTB @R1 ;IGNORE NULL LINE
BEQ START
.CSISPC #OUFDB,#DEFEXT,R1
BCS CMDERR ;PARSE THE 2 NAMES
; PROCESS ALL SWITCHES
MOV (SP)+,R5 ;R5 = # OF SWITCHES
SWTNXT: DEC R5 ;ANY LEFT?
BMI SWEND ;FINISHED IF NOT
MOV (SP)+,R3 ;R3 = ACTUAL SWITCH (VAL+FILE)
BMI 1$ ;CHECK IF VALUE GIVEN
MOV PC,-(SP) ;PSEUDO NON-0 VALUE
1$: MOV #SWTBL-4,R4 ;R4 -> SWITCH TABLE
2$: CMP (R4)+,(R4)+ ;PUSH POINTER
MOV (R4)+,R0 ;R0 = TABLE ENTRY
BEQ SWTILL ;NOT THERE!
CMPB R0,R3 ;IS THIS THE ONE?
BNE 2$ ;KEEP TRUCKIN'
MOV (SP)+,(R4)+ ;SAVE VALUE IN TABLE
SWAB R0 ;SET UP BRANCH AND GO
MOVB R0,@PC
BR .+2
SWBASE=.
SWTILL: ERR ILSW, ;ILLEGAL SWITCH
SWEND: TST INGOTO ;ANY FILE STRUCTURE GIVEN?
BNE GODOIT ;YES, DO FOREIGN STUFF
MOV #R.GOTO,R1 ;NO, ACT LIKE PIP. SET BOTH TO RT11
CLR R3 ;WE'LL RETURN SHORTLY
BR RT11FL ;BUT NOW SET BOTH TABLES
; FILE STRUCTURE SWITCHES: /S /T
SWTTEN: MOV @#SYSPTR,R1 ;/T CAN'T BE DONE IF FG ACTIVE
BIT #FJOB$,CONFIG(R1) ;IS IT?
BEQ SWTFIL ;NO
ERR FRUN,
SWTFIL: MOV @R4,R1 ;R1 -> DISPATCH TABLE
SWAB R3 ;WHICH FILE? ANY VALUE?
BMI SWTERR ;ILLEGAL IF HAS VALUE
BIC #177601,R3 ;REDUCE 0 OR 3 TO 0 OR 2
RT11FL: MOV (PC)+,R4 ;COUNT SIZE OF TABLE
.BYTE GOTOSZ,GOTOSZ ;TWO COUNTERS IN ONE
1$: MOV IOFIL(R3),R0 ;POINT TO CORRECT FILE
TST @R0 ;ALREADY HAD ONE?
BNE SWTERR ;THAT'S A NO-NO
2$: MOV (R1)+,(R0)+ ;COPY A WORD
DECB R4 ;FINISHED WITH TABLE?
BNE 2$ ;0 ENDS TABLE
TST (R3)+ ;SWAP FILE TABLES
MOV #R.GOTO,R1 ;SOURCE IS RT-11 DISPATCH
SWAB R4 ;SECOND TIME AROUND ?
BNE 1$ ;GO FILL RT-11 SIDE
BR SWTNXT ;ALL DONE
IOFIL: .WORD OUGOTO,INGOTO,OUGOTO
; COPY MODE ETC.
SWTMOD: MOV #CPYMOD,R0 ;/A /I /P
SWTCOM: TST @R0 ;ALREADY HAD ONE OF THESE?
BNE SWTERR
MOV @R4,@R0 ;SET MODE
SWTIGN: TST R3 ;INSURE NO VALUE /G
BPL SWTNXT
SWTERR: ERR SWER, ;SWITCH ERROR
; ACTION SWITCHES
SWTACT: MOV #ACTION,R0 ;/C /D /L /Z
BR SWTCOM
; NUMBER OF BLOCKS
SWTNUM: TST R3 ;VALUE IS MANDATORY
BPL SWTERR
BR SWTNXT
; GO TO ACTION ROUTINE
GODOIT: MOV #FREE,R5 ;POINT TO FREE CORE
ADD ACTION,PC ;DO THE THING (COPY = 0)
ACBASE: NOP ;/C => ACTION = 2
.SBTTL COPY DRIVER ROUTINE
COPY: MOV #OUFDB,R0 ;POINT TO OUTPUT FILE NAME
TST @R0 ;SEE IF THERE!
BEQ ERRNOU ;ERROR - NO OUTPUT FILE
.DSTAT R5 ;GET STATUS IN FREE CORE
BCS ERRDEV ;NO SUCH DEVICE!
MOV @R5,-(SP) ;SAVE FOR CALLING OPEN
CALL XPANDI ;GO DO INPUT EXPANSION
TST @R3 ;IF NONE, FILE NOT FOUND
BEQ FNFERR
MOV (SP)+,@R5 ;RESTORE HIS DSTATUS
MOV #OUFDB,R2 ;POINT TO OUTPUT PROTO FOR OPEN
OCALL OPEN ;CALL OPENER
CALL ALCBUF ;ALLOCATE IN/OUT BUFFERS
MOV OUBUFF,-(SP) ;WE USE THIS A LOT
COPYLP: TST @R3 ;ANY FILES TO COPY?
BEQ REENTR ;NO, GET THE ... OUT
MOV #OUFDB,R2 ;POINT GUY FOR FIXING
OCALL ENTE ;ENTER THE FILE
ADD #6,R3 ;ADVANCE POINTER TO GOOD DATA
ICALL LKUP ;OPEN THE FILE FOR INPUT
TST SWT.A ;WHAT KIND OF XFER?
BNE ASCOPY ;GO DO AN ASCII COPY
IMCOPY: MOV @SP,R4 ;POINT TO INPUT BUFFER
MOV INBUFE,R5 ; AND TOP OF BUFFER
ICALL READ ;READ A LOAD
MOV R4,R5 ;TOP OF DATA READ IN R5
MOV @SP,R4 ;START OF DATA IN R4
CMP R4,R5 ;ANYTHING ?
BEQ CPCLOS ;NO, CLOSE THE OUTPUT
OCALL WRIT ;YES, WRITE IT OUT
BR IMCOPY ;LOOP
ASCOPY: MOV @SP,R5 ;START OUTPUT SCANNER
ASLOOP: MOV R5,-(SP) ;SAVE OUTPUT POINTER
MOV INBUFF,R4 ;POINT FOR READING
MOV INBUFE,R5
ICALL READ
MOV R4,R2 ;TOP OF INPUT DATA IN R2
MOV INBUFF,R1 ;BOTTOM OF INPUT IN R1
MOV (SP)+,R5 ;RESTORE OUTPUT POINTER
CMP R1,R2 ;GET ANYTHING ?
BEQ CPFILL ;NO, FILL AND CLOSE
1$: CMP R1,R2 ;DONE WITH THIS INPUT LOAD ?
BHIS ASLOOP ;YES, GET ANOTHER
MOVB (R1)+,R0 ;NO, GET A BYTE
BIC #177600,R0 ;TRIM IT
BEQ 1$ ;IGNORE NULLS
CMP #177,R0 ; AND RUBOUTS
BEQ 1$
CMP #'Z-100,R0 ;STOP ON ^Z
BEQ CPFILL ; AND CLEAN UP
MOVB R0,(R5)+ ;PUT INTO OUTPUT BUFFER
CMP R5,OUBUFE ;FULL ?
BLO 1$ ;NOT YET
MOV @SP,R4 ;YES, POINT TO OUTPUT BUFFER
MOV R1,-(SP) ;SAVE INPUT POINTERS
MOV R2,-(SP)
OCALL WRIT ;WRITE FROM R4 TO R5
MOV (SP)+,R2
MOV (SP)+,R1
MOV @SP,R5 ;START ANEW AT OUTPUT BUFFER
BR 1$ ;KEEP GOING
CPFILL: BIT #1,R5 ;TOP OF OUTPUT ODD ?
BEQ 4$ ;NOPE
CLRB (R5)+ ;YEP, EVEN IT OUT
4$: MOV @SP,R4 ;POINT TO OUTPUT ONE LAST TIME
CMP R4,R5 ;ANYTHING THERE ?
BEQ CPCLOS ;NO
OCALL WRIT
CPCLOS: OCALL CLOS
ADD #12,R3 ;PUSH TO NEXT INPUT FILE
BR COPYLP ;AND GO
REENTR: JMP START
ERRNOU: ERR ILCM ;ILLEGAL IF NO OUTPUT FILE
ERRDEV: ERR ILDE, ;ILLEGAL DEVICE
FNFERR: ERR FINOFN, ;FILE NOT FOUND
.SBTTL DIRECTORY LIST DRIVER
FASTDI: MOV SP,SWT.L
LIST: CALL XPANDI ;GO EXPAND INPUT SPEC.
MOV #CMDBUF,R5 ;POINT TO BUFFER FOR OUTPUT
LISTLP: TST @R3 ;ANY FILES LEFT?
BEQ REENTR
MOV R5,R4 ;PREPARE TO COPY
MOV #40,CONTIG ;TURN OFF CONTIG FLAG
CALL OUTFNM ;PRINT THE FILE NAME
ICALL DIR ;GET DATE AND STUFF
MOV R0,-(SP) ;SAVE IT
CMP (R3)+,(R3)+ ;SKIP 2 WORDS
MOV (R3)+,R0 ;GET FILE SIZE
TST SWT.F
BNE LISTF
CALL R10OU6 ;PRINT 6 CHAR FIELD
MOVB (PC)+,(R4)+ ;BYTE FLAG FOR CONTIG
CONTIG: .WORD 40
MOVB #40,(R4)+
MOV @SP,R0 ;RETRIEVE DATE
CALL DATOUT ;AND PRINT IT
LISTF: TST (SP)+ ;PRUNE DATE
CLRB (R4)+
CMP (R3)+,(R3)+ ;PUSH TO NEXT BLOCK
.PRINT R5 ;PRINT THE MESSAGE
BR LISTLP
.SBTTL ZERO DEVICE DRIVER
DELETE: CALL XPANDI ;FIRST EXPAND LIST
ICALL DELE ;EASY
BR REENTR
ZERO: MOV #START,-(SP) ;DRIVER ZERO ROUTINE RETURNS HERE
MOV INGOTO+$ZERO,-(SP) ;SAVREG WILL RETURN TO DRIVER ZERO
JSR R1,SAVREG ;SAVE ALL REGS
MOV #OUFDB,R4 ;GET AREA FOR RAD50
MOV INFDB,R0 ;GET DEVICE NAME
CALL R50OUT ;CONVERT DEVICE NAME
MOVB #200,(R4)+ ;NO CR
.PRINT #OUFDB
.PRINT #RUSURE ;ASK IF HE IS SURE
.TTYIN R1 ;GET ANSWER
1$: .TTYIN ;SKIP TO LINE FEED
CMP #12,R0
BNE 1$
CMP #'Y,R1 ;WAS HE SURE?
BNE REENTR ;NO
RETURN ;RETURN TO SAVREG, THEN TO DRIVER
.SBTTL FILE NAME OUTPUT
; ROUTINE IS CALLED WITH R3 POINTING TO A FILNAM.EXT IN RAD50
; AND R4 POINTING TO AN OUTPUT AREA
; THE FILE NAME IS CONVERTED TO ASCII AND OUTPUT
; R3 IS ADVANCED
OUTFNM: CALL FNOUT ;PRINT FIL
CALL FNOUT ;PRINT NAM
MOVB #'.,(R4)+ ;PRINT .
FNOUT: MOV (R3)+,R0 ;PRINT NEXT 3 CHARACTERS
R50OUT: JSR R5,CONV ;CONVERT IT
.WORD 3,50 ;3 BYTES OF RADIX 50
1$: MOVB (R2)+,R0 ;GET NEXT CONVERTED BYTE
BMI DONE ;FINISHED ON NEGATIVE
BEQ 2$ ;ZERO BYTE IS BLANK
CMP R0,#32 ;TEST FOR ALFA
BLE 3$ ;GO IF A-Z
SUB #36,R0 ;TEST FOR NUMBER
BCC 4$
2$: MOV #-40,R0 ;FUDGE OTHERS TO SPACE
3$: ADD #20,R0
4$: ADD #60,R0
MOVB R0,(R4)+ ;PUT IN OUTPUT STREAM
BR 1$
.SBTTL OUTPUT CONVERSION (ANY RADIX)
; THIS ROUTINE IS PASSED A NUMBER IN R0 AND A COUNT IN R1
; IT CONVERTS THE NUMBER TO THE RADIX IN 'RADIX' AND LEAVES
; R2 POINTING TO THE RESULT. IF LESS THAN R1 CHARACTERS
; ARE PRODUCED, BLANKS ARE OUTPUT TO (R4)+
DIVIDE: CLR R1 ;DO THE LOOP ONLY ONCE
BR CONV1 ;AND GO DO DIVISION
CONV: MOV (R5)+,R1 ;GET THE MAX FIELD SIZE
CONV1: MOV #DIGITS,R2
MOV R1,-(SP) ;SAVE THE COUNT
CNVLUP: CLR R1 ;CLEAR FOR DIVISION
MOV #17,-(SP) ;16. BIT NUMBERS
DIVLUP: ASL R0 ;THIS IS AN ORDINARY DIVISION
ROL R1
CMP R1,@R5 ;CAN WE DO A SUBTRACT?
BLO NOFIT
SUB @R5,R1
INC R0
NOFIT: DEC @SP
BPL DIVLUP ;NOTE END ON -1
MOVB R1,-(R2) ;SAVE REMAINDER BACKWARDS
ADD (SP)+,@SP ;DECREMENT COUNTER AND PRUNE
BLE 2$ ;DO NOT EXCEED FIELD SIZE
TST R0 ;SHOULD WE CONVERT MORE?
BNE CNVLUP ;YES,DO IT
1$: DEC @SP ;NEED WE FILL?
BMI 2$
MOVB #40,(R4)+ ;YES, PUT OUT BLAN
BR 1$
2$: CMP (SP)+,(R5)+ ;REMOVE PRUNE FROM STACK
RTS R5
.SBTTL DATE OUTPUT UTILITY
; THIS ROUTINE ACCEPTS A DATE IN RT-11 FORMAT IN R0
; AND PUTS IT OUT AS A 9 CHARACTER FIELD TO (R4)+.
; AN INVALID DATE PUTS A NULL FIELD
DATOUT: BIT #36000,R0 ;IS IT A VALID DATE?
BEQ DONE ;NO, EXIT
1$: MOV R0,-(SP) ;GET A 5 BIT FIELD
BIC #177740,@SP ;TRIM THE STACK
ASR R0 ;ADVANCE
ASR R0
ASR R0
ASR R0
ASR R0
BNE 1$ ;IF NOT 0, RETURN FOR NEXT FIELD
MOV 2(SP),R0 ;PUT OUT THE DAY
CALL R10OU2 ; AS A 2 BIT FIELD
MOV (SP)+,R0 ;GET MONTH NUMBER
ASL R0
ASL R0 ;CONVERT TO TABLE INDEX
ADD #MONTHS-4,R0 ;AND POINT TO TABLE
MOV #5,@SP ;PUT OUT 5 CHARS
2$: MOVB (R0)+,(R4)+
DEC @SP
BNE 2$
TST (SP)+ ;PRUNE STACK
MOV (SP)+,R0 ;GET YEAR (REL 1964)
ADD #64.,R0
CALL R10OU2
DONE: RETURN
.NLIST BEX
MONTHS: .ASCII /-JAN-FEB-MAR-APR-MAY-JUN-JUL-AUG-SEP-OCT-NOV-DEC-/
.EVEN
.LIST BEX
.SBTTL DECIMAL NUMBER OUTPUT
R10OU2: MOV #2,R1 ;ENTER HERE FOR 2 DIGITS
BR R10CNV
R10OU6: MOV #6,R1 ;ENTER HERE FOR 6 DIGITS
R10CNV: JSR R5,CONV1 ;DO THE CONVERSION
.WORD 10. ;(BASE 10., OF COURSE)
1$: MOVB (R2)+,R0 ;OUTPUT NEXT DIGIT
BMI DONE
ADD #60,R0
MOVB R0,(R4)+
BR 1$
.SBTTL EXPAND INPUT LIST
.ENABL LSB ;###
XPANDI: .DSTAT R5,#INFDB ;GET A DSTATUS
BCS 4$ ;BAD DEVICE
MOV #INFDB+6,R3 ;PREPARE TO CHECK FOR *.*
CLR R4 ;CLEAR FLAG
MOV @R3,R0 ;CUMULATIVE TEST FOR NULL NAME
CMP R0,#R50STAR ;IS IT A * EXTENSION
BNE 1$
BIS #100000,R4 ;SET FLAG IF SO
1$: BIS -(R3),R0
CMP -(R3),#R50STAR ;IS FILE NAME A *
BNE 2$
COMB R4 ;SET FLAG IF SO
2$: BIS @R3,R0 ;FINISH TEST FOR NULL NAME
BNE 12$ ;TREAT NULL NAME AS *.*
TST @R5 ;UNLESS NON-FILE STRUCTURED
BPL 12$ ; IN WHICH CASE LEAVE NAME
DEC R4 ;SET FLAGS FOR *.*
12$: TST @R5 ;IF IT IS NON-FILE-STR
BMI 13$
TST R4 ; AND IT HAS WILD CARDS
BNE 10$ ; BOOT HIM
13$: TST -(R3) ;DID HE GIVE US A NAME?
BEQ 10$
MOV #BRKBF2,R1 ;POINT HIM TO BRACKETS
TST OUASCI ;IS THIS RIGHT
BNE 3$ ;YES, BUFFER2 IF OUTPUT EXTANT
MOV #BRKBF1,R1
3$: JMP @INGOTO+$EXPA ;GO TO EXPANSION, RETURN TO CALLER
ERRIDV: ;###
4$: ERR ILDE ;BAD DEVICE
;NOTE THAT R2 STILL POINTS TO ASCII NAME
10$: ERR ILCM
.DSABL LSB ;###
.SBTTL RT-11 EXPAND INPUT LIST
; THIS ROUTINE EXPANDS AN INPUT LIST INTO BLOCKS
; WHICH ARE GOOD FOR REOPENS IF /L IS OFF, AND GOOD FOR LISTING
; IF /L IS ON
R.EXPA: MOV @R5,-(SP) ;SAVE THE DSTATUS
.FETCH R5,R3 ;GET HANDLER IN FREE CORE
TST (R0)+ ;MOVE CORE PTR DOWN A WORD ;###
MOV R0,R5 ;NEW FREE CORE PTR
MOV (SP)+,R0 ;R0 = DSTATUS
MOV R3,R2 ;R2 -> INPUT PROTOTYPE
MOV R5,R3 ;R3 -> INPUT LIST
TST SWT.L ;IF DIRECTORY LIST,
BNE 20$ ; THEN ALWAYS EXPAND INPUT
MOV R2,R1 ;POINT R1 AT GIVE FILE NAME
TST (R1)+
TST R4 ;IS THERE A WILD CARD ?
BEQ 5$ ;STRAIGHT FILE NAME IS EASY
20$: .LOCK ;DON'T LET FG USE USR BUFFER
CALL GETDIR ;READ FIRST DIRECTORY BLOCK
1$: BIT @R1,#DIREOB ;END OF DIRECTORY BLOCK ?
BEQ 3$ ;NO
CALL RDDIR ;YES, READ THE NEXT ONE
BNE 1$ ;GOT IT
2$: .CLOSE 17 ;CLOSE DIRECTORY CHANNEL
.UNLOCK ;OK, DONE WITH USRBUF
CMP R3,R5 ;DID WE GET ANY FILES ?
BEQ 30$ ;NO, ERROR
CLR (R5)+ ;SET END OF LIST
CMP ACTION,#2 ;ARE WE COPYING ?
BHI 11$ ;NO, DON'T LOOKUP
MOV R3,R1 ;YES, COPY NAME LIST POINTER
10$: MOV -(R1),-(SP) ;SAVE A RANDOM WORD
MOV @R2,@R1 ;PUT IN DEVICE NAME
.LOOKU 0,R1 ;LOOKUP THE FILE
BCS 30$ ;IT ISN'T THERE
MOV (SP)+,(R1)+ ;RESTORE RANDOM WORD
ADD #6,R1 ;POINT TO SAVESTATUS AREA
.SAVES 0,R1 ;AND SAVE STATUS
BCS ERRIDV ;IF C SET-ILL DEV(MT,CT) ;###
ADD #12,R1 ;POINT TO NEXT BLOCK
TST @R1 ;DONE ?
BNE 10$ ;NOT YET
11$: RETURN
3$: BIT (R1)+,#DIRPRM ;IS THIS A REAL FILE ?
BEQ 8$ ;NO, SKIP IT
CALL STCHEK ;CHECK FOR MATCH WITH INPUT
BNE 8$
5$: MOV (R1)+,(R5)+ ;MOVE IN FILENAME.EXT
MOV (R1)+,(R5)+
MOV (R1)+,(R5)+
MOV (R1)+,4(R5) ;MOVE IN SIZE
TST (R1)+ ;SKIP OTHER SIZE
MOV (R1)+,@R5 ;PUT IN DATE
ADD #8.,(R5)+ ; (MAKE IT REL 1964)
ADD #10,R5 ;SKIP ALL THE REST
TST R4 ;DO WE CONTINUE ?
BEQ 2$ ;NO, GET OUT
BR 9$ ;YES
8$: ADD #DIRESZ-2,R1 ;PUSH OVER ENTRY
9$: ADD XTRABY,R1
BR 1$
30$: ERR FINOFN
.SBTTL RT-11 LOOKUP, READ, AND DIR
R.LKUP: .CLOSE 17 ;CLOSE CHANNEL IN CASE IN USE
.REOPEN 17,R3 ;REOPEN SAVED FILE
CLR R.IBLK ;CLEAR BLOCK NUMBER
RETURN ;DONE
R.READ: MOV R.IBLK,R0 ;GET BLOCK NUMBER
MOV BUFSIZ,R2 ;SIZE OF BUFFER
ADD R2,R.IBLK ;UPDATE BLOCK NUMBER
SWAB R2 ;WORD COUNT AGAIN
.READW 17,R4,R2 ;READ A LOAD
BCS 2$ ;ERROR ?
ASL R0 ;BYTES READ
ADD R0,R4 ;POINT TO TOP OF GOOD STUFF
1$: RETURN
2$: TSTB @#ERRLOC ;EOF TYPE ERROR ?
BEQ 1$ ;YES
ERR INER, ;NO, BADDIE
R.DIR: MOV @R3,R0 ;GET DATE WORD
RETURN ;EASY SAID, EASY DONE
.SBTTL RT-11 OPEN
; THIS ROUTINE PREPARES FOR OUTPUT ON AN RT-11 DEVICE
; IT IS CALLED WITH R5 -> FREE CORE
; AND R2 -> OUTPUT DEV:FILNAM.EXT IN RAD50.
; @R5 IS A DSTATUS FOR DEV:
R.OPEN: MOV @R5,R1 ;SAVE THE DSTATUS
.FETCH R5,R2 ;GET THE HANDLER
BCC 1$ ;SKIP ERROR IF OK
3$: ERR ILDE ;ILLEGAL DEVICE ;###
1$: MOV R0,R5 ;TOP OF HANDLER
MOV R1,R.DEVS ;SAVE THE DSTATUS OF OUR DEVICE
BMI 2$ ;LEAVE ALONE IF FILE STRUCTURED
BIT #10000,R1 ;IS THIS A SPECL DEV?(MT,CT) ;###
BNE 3$ ;IF NE-YES-NOT VALID FOR FILEX ;###
.LOOKU 1,R2 ;ELSE LET IT BE OPEN ON CHANNEL 1
INC R.NCHAN ;MARK THE CHANNEL OPEN
INC R.CHAN ;AND USE CHANNEL 1
2$: RETURN
.SBTTL RT-11 WRITE
; THESE ROUTINES HANDLE OUTPUT TO AN RT-11 DEVICE
R.WRIT: SUB R4,R5 ;COMPUTE SIZE TO OUTPUT
CLR -(SP) ;USE WAIT I/O (& CLC)
ROR R5 ;SIZE IS IN WORDS
MOV R5,-(SP) ;PUT SIZE ON STACK
MOV R4,-(SP) ;PUT OUTPUT POINTER ON STACK
MOV (PC)+,R0 ;BLOCK NUMBER IN R0
R.BLOK: .WORD 0
SWAB R5 ;BLOCK COUNT
ADD R5,R.BLOK ;UPDATE IT
MOV R.CHAN,-(SP) ;BUILD A WRITE EMT
ADD (PC)+,@SP
EMT 220
MOV (SP)+,@PC
.WORD 0
BCS OUTER
RETURN
OUTER: ERR OUER,
.SBTTL RT-11 ENTER
; ENTER AS MANY FILES AS POSSIBLE
; ENTRY: R2 -> OUTPUT PROTOTYPE
; R3 -> INPUT BLOCK
R.ENTE: CLR R.BLOK ;WRITE TO BLOCK 0
TST R.NCHAN ;ANYTHING STILL OPEN?
BGT 8$ ;YES, JUST VANISH
JSR R1,SAVREG ;IT'S REG TIME!
CLR R1 ;R1 = CHANNEL COUNTER
1$: MOV OUBUFF,R4 ;USE OUT BUFFER FOR SCRATCH
MOV R4,R0 ;SAVE LOCATION FOR ENTER
MOV R2,R5 ;R5 -> OUTPUT PROTOTYPE
MOV (R5)+,(R4)+ ;COPY DEVICE
CALL OEXPND ;EXPAND OUTPUT STARS
INC R1 ;BUMP CHANNEL
MOV R1,6$ ;SET FOR ENTER
MOV R.LENG,-(SP) ;SET UP FILE LENGTH
BNE 5$ ;GOOD, HE GAVE ONE
MOV 4(R3),@SP ;MOVE IN LENGTH FROM INPUT
5$: ADD (PC)+,(PC)
EMT 40+0 ;PROTOTYPE ENTER EMT
6$: 0
BCS R.DEFU ;IS THE DEVICE FULL?
CMP R1,#16 ;ENOUGH ALREADY ?
BHI 7$ ;YES
BLO 10$ ;NO
CMP INGOTO,R.GOTO ;RT-11 INPUT ?
BEQ 7$ ;YES, LEAVE CH. 17
10$: ADD #12,R3 ;PUSH INPUT POINTER
TST @R3 ;IS THERE A FILE?
BNE 1$ ;YAH, ENTER IT
7$: MOV R1,R.NCHAN ;SAVE NUMBER OF ENTERS
MOV #1,R.CHAN ;SET STARTING CHANNEL
8$: RETURN
R.DEFU: ERR DEFU, ;DEVICE FULL
.SBTTL RT-11 CLOSE
R.CLOS: MOV #R.DEVS,R1 ;POINT TO STATUS 'N STUFF
TST (R1)+ ;IS IT FILE STRUCT ?
BPL 4$ ;NAH, JUST LEAVE CHANNEL OPEN
MOV (R1)+,R0 ;GET CURRENT CHANNEL
CMP R0,@R1 ;WE UP TO THE TOP YET ?
BLO 3$ ;NO, AOK
1$: MOV R0,2$ ;SET UP CLOSE
ADD (PC)+,@PC
.CLOSE 0
2$: 0
DEC R0 ;ANY MORE TO DO ?
BGT 1$ ;YES
CLR @R1 ;NEXT ENTER WILL DO THINGS!
3$: INC R0 ;RESET STARTING CHANNEL
MOV R0,-(R1) ;SAVE IT
4$: RETURN
.SBTTL RT-11 DIRECTORY READ
; THIS ROUTINE READS THE RT-11 DIRECTORY INTO THE USR'S BUFFER
; IT UPDATES BLKEY AND CHKEY AS NEEDED
GETDIR: TST R0 ;CHECK DEVICE STATUS
BPL BADDIR ;NO GOOD IF NO FILE STR.
MOV @R2,@R5 ;COPY DEVICE NAME
CLR 2(R5) ;AND OPEN NON-FILE STR.
.LOOKU 17,R5 ; ON CHANNEL 1
BCS BADDIR ;BADDIE
.SAVES 17,R5 ;NEED UNIT NUMBER
.REOPE 17,R5 ;AND NEED DIRECTORY OPEN
MOV 10(R5),-(SP) ;COMPUTE CHKEY FOR IT
MOVB @R5,@SP
BIC #301,@SP
CMP @SP,@CHKEY ;IS THE DIRECTORY THERE ?
BEQ GETDI2 ;IT MIGHT BE
CLR @(PC)+ ;IT CAN'T BE, FORCE READ
BLKEY: .WORD 0
GETDI2: MOV (SP)+,@(PC)+ ;SET CHKEY
CHKEY: .WORD 0
MOV #1,DBLOCK ;START AT DIR BLOCK 1
RDDIR: MOV (PC)+,R0 ;GET DIR BLOCK
DBLOCK: .WORD 0
BEQ 2$ ;ZERO => END OF DIR
MOV USRBUF,R1 ;POINT TO BUFFER
CMP R0,@BLKEY ;IS IT ALREADY IN ?
BEQ 1$ ;YEP
ASL R0 ;NO, COMVERT SEGMENTS TO BLOX
ADD #DIRBLK-2,R0 ;POINT TO ABSOLUTE BLOCK
.READW 17,R1,#512. ;READ 2 BLOCKS
BCS BADDIR ;OUCH !
CMP 4(R1),#37 ;SLIGHT LEGALITY TEST
BHI BADDIR ;NO GO
MOV DBLOCK,@BLKEY ;SET UP WHAT'S IN
1$: TST (R1)+ ;PUSH OVER HIGH
MOV (R1)+,DBLOCK ;SAVE LINK
TST (R1)+
MOV (R1)+,XTRABY ;EXTRA BYTES
TST (R1)+ ;POINT TO FIRST ENTRY
2$: RETURN
BADDIR: ERR DIER
.SBTTL BUFFER ALLOCATION ROUTINE
; THIS ROUTINE IS CALLED TO GET BUFFERS FOR INPUT AND OUTPUT.
; IT GIVES ALL OF CORE TO BOTH INBUFF AND OUBUFF IF SWT.A IS OFF
; IT GIVES HALF OF CORE TO EACH IF SWT.A IS ON, BUT SWT.T IS OFF
; (SINCE TOPS-10 USES SELF-GOTTEN BUFFERS)
ALCBUF: MOV R5,INBUFF ;INPUT BUFFER IS LOWER
MOV R5,(PC)+
INBUFE: .WORD 0
MOV CORTOP,R0 ;TOP OF CORE IN R0
SUB R5,R0 ;COMPUTE AREA REMAINING
BLO COROVR ;NONE ALREADY
BIC #1777,R0 ;ROUND TO INTEGRAL # BLOX
BEQ COROVR ;NOT ENOUGH ROOM FOR US
TST SWT.A ;ASCII MODE?
BEQ 1$ ; NO, GO DO UNIBUFFER
ROR R0 ;HALVE CORE
ADD R0,R5 ;BUMP BUFFER BY SIZE
1$: ADD R0,INBUFE ;FIX END POINTER
MOV R5,OUBUFF ;SAVE POINTER
ADD R0,R5 ;R5 IS NOW A TOP O' CORE PTR
MOV R5,(PC)+ ;SAVE TOP OF OUTPUT BUFFER
OUBUFE: .WORD 0
SWAB R0 ;MAKE SIZE A BLOCK COUNT
ASR R0
MOV R0,BUFSIZ ;SAVE BUFFER SIZE
RETURN ;LEAVE WITH BUFFERS SET UP
COROVR: ERR COOV,
.SBTTL EXPAND OUTPUT FILE NAME
; THIS ROUTINE EXPANDS OUTPUT FILE NAMES, SUBSTITUTING FOR STARS
; WHEN APPROPRIATE
OEXPND: CMP @R5,#R50STAR ;IS PROTO FILNAM = * ?
BEQ 2$ ;YES, GET INPUT NAME
MOV (R5)+,(R4)+ ;NO, COPY FILENAME
MOV (R5)+,(R4)+
CMP (R3)+,(R3)+ ;PUSH INPUT
BR 3$
2$: MOV (R3)+,(R4)+
BEQ 9$ ;NULL FILE NAME IS BADDIE
MOV (R3)+,(R4)+
CMP (R5)+,(R5)+
3$: MOV (R3)+,(R4)+ ;COPY INPUT EXTENSION
CMP @R5,#R50STAR ;WAS * A GOOD GUESS ?
BEQ 4$ ;YES
MOV (R5)+,-2(R4) ;NO, COPY PROTO EXT
4$: RETURN
9$: ERR FINA, ;FIL NAM NULL
STCHEK: TSTB R4 ;IS FILE NAME = *
BNE 1$
CMP @R1,INFDB+2 ;NO, CHECK FOR MATCH
BNE 3$
CMP 2(R1),INFDB+4
BNE 3$
1$: TST R4 ;FILE NAME MATCHES. IS EXT = * ?
BMI 2$
CMP 4(R1),INFDB+6
BNE 3$
2$: SEZ ;RETURN EQUAL ON MATCH
3$: RETURN
.SBTTL DOS EXPAND INPUT LIST
; THIS ROUTINE EXPANDS ANY *.* CONSTRUCTION FOR A DOS
; DEVICE. THE FORMAT OF THE 5-WORD SAVESTATUS BLOCK IS:
;
; WORD 1: BIT 15=0 IF LINKED, 1 IF CONTIG
; BITS 11-0 ARE THE DATE AS 1000*(YR-70)+DAY
; WORD 2: STARTING BLOCK NUMBER ON DEVICE
; WORD 3: NUMBER OF BLOCKS IN FILE (# IN USE IF CONTIG)
; WORD 4: LAST BLOCK NUMBER
; WORD 5: PROTECTION
;
; THE CALL IS A STANDARD ?.EXPA CALL:
; R1 -> BUFFER WITH [] STRING (BACKWARDS)
; R2 -> ASCII STRING OF FILNAM.EXT ENDED BY / = OR 0BYTE
; R3 -> 4 WORDS OF DEV:FILNAM.EXT IN RAD50
; R4 HAS *.* FLAG (LOW BYTE, HIGH BYTE)
; R5 -> FREE CORE
.ENABL LSB
S.EXPA: CALL PPSCAN ;GET PROJECT/PROG IN R2
MOV @R5,R1 ;GET DSTATUS
DECB R1 ;CHECK FOR RK (0) OR DT (1)
BEQ 9$ ;DECTAPE IS ALWAYS OK
BGT 90$ ;NON-RK IS ILLEGAL
MOV SWT.Z,-(SP) ;AND IF WE ARE NOT ZEROING
BIS SWT.D,(SP)+ ; NOR DELETING
BNE 90$ ; THEN RK IS GOOD
9$: MOV R3,R2 ;PREPARE TO CALL INITIALIZER
CALL S.INIT ;INITIALIZE DOS FORMAT
CLR R2 ;INITIALIZE FILE NUMBER TO 0
TST SWT.Z ;IF WE WANT TO ZERO IT, JUST OPEN DEVICE
BNE 30$ ; AND RETURN
MOV R5,R3 ;SAVE POINTER TO STATUS BLOX
TSTB R1 ;WAS THAT RIGHT?
BMI 1$ ;IF DISK, GO GET MFD AND FIND UFD
CALL S.DGET ;READ DIRECTORY, BMAP, R1-> DIR
MOV (PC)+,R0 ;SET TO OVERFLOW AFTER 28. ENTRIES
.BYTE 28.,28.
TST (R1)+ ;ADVANCE TO GOOD DATA
BR 6$ ;BEGIN SCAN
1$: MOV #1,S.BLOK ;RK BLOCK 1 LINKS TO MFD
CALL S.RDLK ;GET POINTER IN
2$: MOV #63.,R1 ;63 PPN'S PER UFD BLOCK
CALL S.RDLK ;GET THE UFD BLOCK
BCC 4$ ;GOT IT. ENTER THE LOOP
ERR NOUF,
3$: ADD #6,R0 ;GO TO NEXT UFD ENTRY
DEC R1 ;ANY MORE ?
BEQ 2$ ;NO, NEXT BLOCK
4$: CMP S.PPDF,(R0)+ ;IS THIS THE ONE ?
BNE 3$ ;NO, KEEP TRUCKING
MOV @R0,S.BLOK ;GOT IT. POINT TO STARTING BLOCK
5$: CALL S.RDLK ;NEXT UFD BLOCK FOR EXPANSION
BCS 20$ ;NO MORE. GET OUT OF THIS MESS
MOV R0,R1 ;R1 -> FILE ENTRIES
MOV #28.,R0 ; (28. OF THEM)
6$: INC R2 ;BUMP FILE NUMBER
TST @R1 ;ANY FILE IN THIS SLOT ?
BEQ 7$ ;NO. IGNORE IT
CALL STCHEK ;YES. DOES IT MATCH IN SPEC ?
BEQ 10$ ;YES. WE GOT A HIT
7$: ADD #22,R1 ;NO MATCH. BUMP TO NEXT ENTRY
8$: DECB R0 ;ANY ENTRIES LEFT ?
BNE 6$ ;YES
SWAB R0 ;NO. DONE FIRST BLOCK OF DT?
BEQ 5$ ;NO, LINK TO NEXT UFD BLOCK
ADD #4*2,R1 ;YES, POINT TO REST OF DT UFD
BR 6$
10$: TST SWT.D ;ARE WE DELETING?
BEQ 12$ ;NO, GO BUILD LIST IF INPUT EXPANSION
MOV #9.,-(SP) ;CLEAR 9-WORD ENTRY
11$: CLR (R1)+
DEC @SP
BNE 11$
TST (SP)+ ;PRUNE
MOV R2,(R5)+ ;AND BUILD A LIST OF FILE NUMBERS
BR 14$
12$: MOV (R1)+,(R5)+ ;COPY FILNAM EXT
MOV (R1)+,(R5)+
MOV (R1)+,(R5)+
MOV (R1)+,(R5)+ ;COPY CREATION DATE, TYPE
TST (R1)+ ;BUMP OVER FOUL WORD
MOV (R1)+,(R5)+ ;COPY START BLOCK #
MOV (R1)+,(R5)+ ;COPY LENGTH
TST -6(R5) ;MUST WE FIX UP CONTIG LENGTH?
BPL 13$ ;NO, GO ON
MOV @R1,-(R5) ;COPY END BLOCK NUMBER
SUB -2(R5),@R5 ;SUBTRACT START BLOCK NO
INC (R5)+ ;AND ADD ONE
13$: MOV (R1)+,(R5)+ ;COPY END BLOCK NUMBER
MOV (R1)+,(R5)+ ;COPY PROTECTION
14$: TST R4 ;WERE WE EXPANDING ONLY ONE FILE?
BNE 8$ ;STARS IN MY EYES, KEEP TRYING
20$: CLR (R5)+ ;SET END OF LIST
30$: RETURN
90$: ERR ILDE ;ILLEGAL DEVICE
.DSABL LSB
.SBTTL DOS LOOKUP (REOPEN) FILE
S.LKUP: MOV R3,R2 ;COPY INPUT LIST POINTER
TST (R2)+ ;LINKED OR CONTIG?
BMI 1$ ;GO IF CONTIG
MOV (R2)+,S.BLOK ;SET UP START BLOCK
CLR @R2 ;FORCE READ ON ENTRY
1$: RETURN
.SBTTL DOS READ INPUT FILE
S.READ: MOV R3,R2 ;POINT TO FILE DATA
TST (R2)+ ;LINKED OR CONTIG?
BMI S.RCTG ;GO TO READ CONTIGUOUS
MOV (R2)+,R0 ;GET POINTER INTO BUFFER
BEQ 6$ ;0 POINTER => EOF
TST @R2 ;WHICH DIRECTION WAS IT READ?
BPL 5$ ;FORWARD
BR 3$
1$: MOV #-254.,@R2 ;SET FOR BUFFER LOAD
2$: MOV -(R0),(R4)+ ;MOVE A WORD
CMP R4,R5 ;END OF BUFFER?
BHIS 6$ ;YES, GO BACK TO WRITE
3$: INC @R2 ;ANY MORE HERE?
BLE 2$
4$: CALL S.RDLK ;READ LINKED BLOCK
BCS 6$ ;RETURN IF END
TST S.PBLK ;WHICH WAS WAS IT DONE?
BMI 1$ ;GO IF WRITTEN BACKWARDS
MOV #255.,@R2 ;SET UP COUNT
5$: DEC @R2 ;ANY MORE LEFT FORWARD?
BMI 4$
MOV (R0)+,(R4)+
CMP R4,R5
BLO 5$
6$: MOV R0,-(R2) ;SAVE POINTER FOR NEXT TIME
RETURN
S.RCTG: MOV (R2)+,R0 ;BLOCK NUMBER TO START READ
MOV BUFSIZ,R5 ;NUMBER OF BLOCKS IN BUFFER
SUB R5,@R2 ;DECREASE BLOCKS LEFT IN FILE
BHIS 1$ ;OK, IT FITS
ADD @R2,R5 ;RESET R5 TO BLOCK COUNT
BEQ 2$ ;RETURN ERROR IF NONE LEFT
CLR @R2
1$: ADD R5,-(R2) ;ADJUST NEXT START BLOCK
SWAB R5 ;MAKE WORD COUNT
.READW 0,R4,R5 ;READ BLOCK
BCS 3$
ASL R5 ;COMPUTE TOP OF AREA
ADD R5,R4
2$: RETURN ;RETURN (NOTE CLEAR CARRY)
3$: ERR INER ;HARD ERROR
.SBTTL DOS OPEN OUTPUT DEVICE
.ENABL LSB
S.OPEN: DECB @R5 ;MUST BE DECTAPE
BNE 91$ ; ELSE ILLEGAL
CALL S.INIT ;INITIALIZE STUFF
MOV S.BMAP,CORTOP ;ALLOW BIT MAP TO BE RESIDENT
CALL S.DGET ;GET DIRECTORY INTO CORE
MOV (PC)+,R0 ;CHECK 28 FILENAMES IN EACH BLOCK
.BYTE 28.,28.
TST (R1)+ ;ADVANCE TO FIRST NAME
1$: TST @R1 ;EMPTY DIR SLOT?
BEQ 6$ ;YUP
MOV R3,R2 ;R2 -> EXPANDED LIST
3$: MOV R1,R4 ;R4 -> NAME IN DIRECTORY
CMP (R2)+,(R4)+ ;THIS EXPANDED NAME MATCH?
BNE 5$ ;NO
CMP (R2)+,(R4)+
BNE 4$
CMP @R2,@R4
BEQ 92$ ;ENTER ERROR, FILE ALREADY EXISTS
4$: TST -(R2) ;FIX PTR TO INPUT LIST
5$: ADD #16,R2 ;ADVANCE TO NEXT INPUT NAME
TST @R2 ;END OF LIST?
BNE 3$ ;NO
6$: ADD #22,R1 ;ADVANCE TO NEXT FILENAME IN DIR
DECB R0 ;28 DONE YET?
BNE 1$ ;NO
SWAB R0 ;COUNT AGAIN
BEQ 10$ ;DONE, NO ERROR, SO RETURN
ADD #8.,R1 ;SKIP JUNK BETWEEN BLOCKS
BR 1$
S.DGET: MOV S.DBUF,R1 ;POINT TO DIR BUFFER
.READW 0,R1,#256.*3,#102 ;READ DOS DIRECTORY
BCS 90$ ;ERROR
10$: RETURN
90$: ERR INER
92$: MOV #CMDBUF,R4 ;POINT TO BUFFER FOR FILE NAME
MOVB #'?,(R4)+ ;START WITH QUERULOUS LOOK
MOV R2,R3 ;GET POINTER TO FILE NAME
CMP -(R3),-(R3) ;FIX IT
CALL OUTFNM ;CONVERT FILE NAME
MOVB #200,(R4)+
.PRINT #CMDBUF ;TELL HIM WHICH FILE
.PRINT #EXISTS ;FINISH THE MESSAGE
JMP START
S.INIT: .FETCH R5,R2 ;INITIALIZE DOS. GET HANDLER INTO FREE CORE
BCS 91$ ;NO GOOD
MOV R0,R5 ;UPDATE TOP OF CORE
MOV R0,S.BUFF ;ALLOCATE DOS BUFFER
ADD #512.,R5 ;UPDATE FREE CORE
MOV @R2,@R0 ;COPY DEVICE NAME
CLR 2(R0) ;OPEN NON-FILE-STRUCTURED
.LOOKU 0 ;OPEN ON CHANNEL 0
BCC 10$ ;RETURN IF NO ERROR
91$: ERR ILDE
.DSABL LSB
.SBTTL DOS ENTER OUTPUT FILE
; THIS ROUTINE ENTERS A FILE ON THE OUTPUT TAPE
; IT ASSUMES THAT THE DIRECTORY BLOCKS ARE IN CORE
S.ENTE: JSR R1,SAVREG ;PRESERVE EVERYTHING
CLR S.NBLK ;ZERO LENGTH SO FAR
CLR S.BLOK ;TELL ALLOCATE NO TO WRITE
MOV #100,R1 ;START LOOKING AT 100
CALL S.BAL2 ;GET INITIAL BLOCK NUMBER
MOV (PC)+,R1 ;COUNT TWICE
.BYTE 28.,28.
MOV S.DBUF,R0 ;POINT TO DIRECTORY
TST (R0)+ ;SKIP LINK
MOV #S.FNUM,R4 ;COUNT FILE NUMBER
CLR @R4
1$: INC @R4 ;NEXT SLOT
TST @R0 ;USEFUL ?
BEQ 2$ ;YES
ADD #22,R0 ;NO, PUSH ON
DECB R1 ;DONE HERE ?
BNE 1$ ;NO
ADD #8.,R0 ;ADVANCE TO NEXT BLOCK
SWAB R1 ;GET ANOTHER COUNT
BNE 1$ ;GO IF 2ND TIME
ERR DEFU ;NO ROOM
2$: TST (R4)+ ;OVER FILE NUMBER
MOV R0,(R4)+ ;SAVE SLOT PTR
MOV #OUFDB+2,R5 ;POINT TO PROTOTYPE
CALL OEXPND ;GET OUTPUT NAME
MOV S.BLOK,S.FBLK ;SAVE STARTING BLOCK #
RETURN ;DONE
.SBTTL DOS ALLOCATE BLOCK IN OUTPUT FILE
; THIS ROUTINE RETURNS THE NEXT AVAILABLE BLOCK ON THE DOS
; OUTPUT TAPE IN R1. IT IS NEGATIVE IF TRANSFER
; SHOULD BE DONE BACKWARD.
; IF THE DEVICE IS FULL, AN ERROR IS ISSUED
S.BALC: MOV S.BLOK,R1 ;GET THE MOST RECENT BLOCK NUMBER
S.BAL2: CLR -(SP) ;PUT A CLEAN WORD ON THE STACK
MOV #1,R0 ;R0 IS THE DIRECTION FLAG
TST R1 ;WHICH WAY WERE WE GOING ?
BPL 1$ ;FORWARD, BY JOVE
NEG R1 ;GET ABSOLUTE BLOCK NUMBER
NEG R0 ;AND REVERSE DIRECTION FLAG
SUB #8.,R1 ;START AT 4 BELOW THIS
1$: ADD #4,R1 ;START AT 4 ABOVE THIS
12$: BMI 15$ ;BLOCK NUMBER TOO LOW. GO REVERSE
CMP R1,#575. ;OFF HIGH END ?
BGT 15$ ;YEP, TURN AROUND
11$: MOV R1,R2 ;TAKE BLOCK NUMBER
BIC #177770,R2 ; MOD 8
MOVB BITTBL(R2),@SP ; AND GET A SHIFTED BIT
MOV R1,R2 ;NOW GET BLOCK NUMBER
ASR R2 ; MOD 8
ASR R2
ASR R2
ADD S.BMAP,R2 ;POINT TO THE MAP BYTE
BITB @SP,@R2 ;IS IT FREE ?
BEQ 20$ ;WE GOT ONE, WE GOT ONE !
ADD R0,R1 ;SHUCKS. MOVE BLOCK NUMBER
BR 12$ ;AND KEEP LOOKING
15$: MOV #575.,R1 ;TRY STARTING AT THE TOP
NEG R0 ;AND REVERSE DIRECTION
BMI 16$ ;AH, BUT IF WE TURN FORWARD
MOV R0,R1 ; THEN START AT BLOCK 1
16$: COM @SP ;DID WE ALREADY FLIP TWICE ?
BMI 11$ ;NO, IT IS OK
ERR DEFU ;DEVICE FULL !
20$: BISB (SP)+,@R2 ;MARK BLOCK IN USE
MOV S.BUFF,R2 ;POINT TO OUTPUT BUFFER
TST (R2)+ ;SAVE FIRST DATA WD PTR
MOV R2,S.BPTR
MOV #256.,S.BCTR ;COUNT OF 256
TST R0 ;WHICH DIRECTION WAS THAT ?
BGT 21$ ;GOOD IF POSITIVE
NEG S.BCTR ;MARK BACKWARDS IN NEXT LOAD
ADD #254.*2,S.BPTR ;START AT TOP
NEG R1 ;GIVE HIM A NEGATIVE NUMBER
21$: INC S.NBLK ;BUMP NUMBER OF BLOX IN FILE
S.FLSH: MOV S.BUFF,R2 ;POINT TO DATA BUFFER
MOV S.BLOK,R0 ;BLOCK # TO WRITE
BEQ 33$ ;0 => INITIALIZATION
BPL 31$ ;FORWARD
MOV R1,255.*2(R2) ;REVERSE. SET LINK WORD AT TOP
NEG R0 ;ABSOLUTE BLOCK
BR 32$
31$: MOV R1,@R2 ;FORWARD. SET LINK AT BOTTOM
32$: .WRITW 0,R2,#256. ;WRITE 1 BLOCK
BCS S.OUE1 ;OUT ERROR
33$: MOV R1,S.BLOK ;SAVE NEXT BLOCK TO GO
MOV #256.,R1 ;COUNT TO CLEAR
34$: CLR (R2)+
DEC R1
BNE 34$
RETURN
BITTBL: .BYTE 1,2,4,10,20,40,100,200
.SBTTL DOS WRITE OUTPUT BUFFER
.ENABL LSB
1$: CALL S.BALC ;LINK TO NEXT BUFFER, DUMP THIS ONE
S.WRIT: MOV S.BPTR,R1 ;POINT TO OUTPUT STUFF
MOV S.BCTR,R2 ;NUMBER OF WDS LEFT
BMI 20$ ;GO IF BACKWARDS
10$: CMP R4,R5 ;DONE ?
BHIS 30$ ;YEP
DEC R2 ;ROOM ?
BEQ 1$ ;NO, ALLOCATE & TRY AGAIN
MOV (R4)+,(R1)+ ;MOVE WORD IN
BR 10$
21$: INC R2 ;ROOM ?
BEQ 1$ ;NO
MOV (R4)+,-(R1) ;PUT IN A WORD
20$: CMP R4,R5 ;REVERSE. DONE ?
BLO 21$ ;NOPE
30$: MOV R1,S.BPTR ;SAVE POINTER
MOV R2,S.BCTR ;SAVE COUNT (NEVER 0!)
RETURN
.DSABL LSB
S.CLOS: MOV S.BLOK,-(SP) ;SAVE LAST BLOCK
CLR R1 ;DONE. LINK IS 0 (I.E. END)
CALL S.FLSH ;FLUSH OUT BUFFER
MOV (SP)+,S.LBLK ;SET LAST BLOCK NO.
MOV R3,-(SP) ;SAVE R3
MOV #S.FNUM,R3 ;POINT TO DIRECTORY STUFF
MOV (R3)+,R0 ;R0 = FILE NUMBER
CALL GETMAP ;GET THE FILE MAP
MOV R0,-(SP) ;SAVE MAP POINTER
MOV S.BMAP,R1 ;POINT TO PERM. MAP
MOV (PC)+,R2 ;GET COUNTER(S)
.BYTE 36.,36. ;36 WDS/MAP
41$: MOV (R1)+,(R0)+ ;MOVE PBM INTO FBM
DECB R2
BNE 41$
CALL S.DGET ;GET OLD DIRECTORY STUFF
MOV (SP)+,R0 ;POINT TO FBM AGAIN
MOV S.BMAP,R1 ;POINT TO PBM (OLD)
SWAB R2 ;COUNT
42$: BIC @R1,@R0 ;MAKE FBM HAVE ONLY NEW BITS
BIS (R0)+,(R1)+ ;MAKE PBM HAVE ALL BITS
DEC R2
BNE 42$
.WRITW 0,S.BUFF,#256.,S.BLOK ;PUT OUT FBM
BCS S.OUE1 ;OUTPUT ERROR
MOV (R3)+,R1 ;POINT TO DIR SLOT
MOV #9.,R2 ;9 WD ENTRY
43$: MOV (R3)+,(R1)+
DEC R2
BNE 43$
CALL S.DPUT ;REWRITE DIRECTORY
MOV (SP)+,R3 ;RESTORE R3
RETURN
S.OUE1: ERR OUER
.SBTTL DOS DIRECTORY LIST LINE
S.DIR: MOV @R3,R0 ;GET DATE WORD, CONTIG FLAG
BPL 1$ ;SKIP IF CONTIG
MOV #'C,CONTIG ;SET OUTPUT FLAG
1$: BIC #100000,R0 ;ISOLATE DATE
JSR R5,DIVIDE ;DIVIDE BY 1000.
.WORD 1000. ;GIVING YR-70 IN R0, DAY IN R1
ADD #6,R0 ;CONVERT TO YR-64
MOV #LFEB,R2 ;PREPARE TO FIX FEB
MOVB #28.,@R2 ;FEBRUARY HAS 28 DAYS
BIT #3,R0 ; EXCEPT ON LEAP YEAR
BNE 2$ ; WHEN IT HAS
INCB @R2 ; TWNWTY-NINE
2$: DEC R2 ;POINT TO MONTH SIZES
CLR -(SP) ;FOR FULLWORD ARITH
3$: ADD #2000,R0 ;INCREMENT MONTH FOR RT-11
MOVB (R2)+,@SP ;PUT ON STACK TO EXTEND TO WORD
SUB @SP,R1 ;TAKE OUT MONTH SIZE
BGT 3$ ;CONTINUE IF NOT <= 0
ADD (SP)+,R1
4$: ADD #40,R0 ;DO DIDDLE LOOP TO SET DAY
DEC R1
BGT 4$
RETURN
.NLIST BEX
LFEB=.+1
.RADIX 10
LMONTH: .BYTE 31,28,31,30,31,30,31,31,30,31,30,31
.RADIX 8
.EVEN
.LIST BEX
.SBTTL DOS ZERO DIRECTORY
; THIS ROUTINE ZEROS A DECTAPE DIRECTORY IN DOS FORMAT
; IT CLEARS THE FILE BITMAP BLOCKS IN 70-77,
; AND WRITES A PROTOTYPE MFD CONTAINING ONE ENTRY (CURRENT PPN)
; IT CLEARS THE UFD AND PROPERLY INITILAIZES THE MASTER BIT MAP
S.ZERO: CALL XPANDI ;GO THROUGH EXPAND TO OPEN FILE
.QSET R5,#2 ;GIVE US SOME QUEUE SPACE
MOV R0,R5 ;NEW AVAIL CORE
ADD #256.*2,R5 ;TOP OF PROTOTYPE BIT MAP
MOV (PC)+,R1 ;NUMBER OF WORDS TO SET TO -1
.BYTE 256.-4.-36.,35. ;COUNT OF -1 SET, 0 SET
1$: MOV #-1,-(R5)
DECB R1
BNE 1$
SWAB R1 ;NUMBER OF WORDS TO CLEAR (UNUSED BLOCKS)
2$: CLR -(R5)
DEC R1
BNE 2$
MOV #S.ZFMT,R1 ;POINT TO FORMATTED AREA
3$: MOV (R1)+,-(R5) ;PLACE THE START OF THE BIT MAP IN
BNE 3$ ;CONVENIENTLY WORD 0 IS 0
COMB 17(R5) ;SAY THE FILE BIT MAPS ARE IN USE
MOV #37,20(R5) ;AS ARE MFD0/1, UFD0/1, AND MASTER MAP
MOV #70,R3 ;BEGIN WRITING BLOCK 70
MOV #10,R4 ;CLEAR EIGHT FILE MAP BLOCKS
MOV (R1)+,R2 ;GET WORD COUNT, POINT TO DATA
4$: .WRITE 0,R1,R2,R3 ;R1->DATA R2=WORD COUNT R3=BLOCK
BCS S.OUE1 ;OUTPUT ERROR
INC R3 ;NEXT BLOCK
DEC R4 ;DO THIS AGAIN?
BGT 4$ ;GO IF STILL CLEARING
ASL R2 ;DOUBLE WORD COUNT
ADD R2,R1 ;BUMP BUFFER POINTER
MOV (R1)+,R2 ;GET NEW WORD COUNT
BNE 4$ ;GO IF END OF LIST
.WRITE 0,R5,#256.,R3 ;WRITE OUT THE BIT MAP
BCS S.OUE1 ;OUTPUT ERROR
.WAIT 0 ;LET IT RUN TO COMPLETION
BCS S.OUE1 ;OUTPUT ERROR
RETURN ;EXIT LAUGHING
.SBTTL DOS DELETE FILES FROM TAPE
; THIS ROUTINE DELETES FILES FROM A DOS DECTAPE
; R5 HAS AVAIL CORE WHEN CALLED
; IT EXPANDS THE INPUT LIST, DELETING FILES ENTRIES IN THAT ROUTINE
; THE UFD BLOCKS AND THE MASTER BIT MAP ARE KEPT IN CORE AS
; THE INDIVIDUAL FILE MAPS ARE READ AND USED TO CLEAR THE MASTER
S.DELE: MOV (R3)+,R0 ;GET FILE NUMBER
BEQ S.RTS2 ;NO FILES FOUND, GO HOME
CALL GETMAP ;GET MAP IN CORE, POINT R0 TO IT
MOV #36.,R2 ;36 WORD ENTRIES
MOV S.BMAP,R1 ;POINT TO MASTER MAP
2$: BIC (R0)+,(R1)+
DEC R2
BNE 2$
TST @R3 ;ANY MORE FILES TO DO?
BNE S.DELE ;AYE
S.DPUT: .WRITW 0,S.DBUF,#256.*3,#102 ;OUTPUT THE UFD AND MASTER MAP
BCS S.OUE1 ;OUTPUT ERROR
S.RTS2: RETURN
; GETMAP GETS THE BLOCK WITH THE FILE'S MAP INTO S.BUFF AREA AND
; POINTS R0 TO THE PROPER ENTRY
GETMAP: MOV R0,-(SP) ;HOLD ONTO NUMBER
MOV #67,R0 ;ONE TOO LOW FOR PSEUDO-DIVIDE
DEC @SP ;MAKE BLOCK INTO PROPER RANGE
1$: INC R0 ;NEXT BLOCK
SUB #7,@SP ; CONTAINS SEVEN MAPS
BPL 1$ ; NONE OF WHICH WE WANT
ADD #7,@SP ;@SP NOW HAS RELATIVE FILE IN MAP
CMP R0,S.BLOK ;IS THE MAP BLOCK ALREADY IN CORE?
BEQ 2$ ;YUP
MOV R0,S.BLOK ;NOW IT IS
CALL S.RD1 ;GO READ ONE BLOCK
2$: MOV S.BUFF,R0 ;POINT TO MAP BLOCK
3$: DEC @SP ;COUNT DOWN ENTRIES
BMI 4$
ADD #36.*2,R0 ;AS WE COUNT UP MAPS
BR 3$
4$: TST (SP)+ ;PRUNE
RETURN
S.RD1: .READW 0,S.BUFF,#256. ;READ ONE BLOCK WHOSE # IS IN R0
BCC S.RTS2 ;RETURN IF SUCCESSFUL
ERR INER ;INPUT ERROR
.SBTTL DOS READ NEXT LINKED BLOCK, PPSCAN
; ROUTINE TO READ THE NEXT BLOCK OF A LINKED DOS FILE
; IT SETS S.BLOK FOR THE NEXT READ, AND LEAVES R0
; POINTING CORRECTLY ACCORDING TO THE DIRECTION READ
S.RDLK: MOV R1,-(SP) ;SAVE A REG
MOV #S.BLOK,R1 ;POINT
MOV (R1)+,R0 ;R0 = S.BLOK
MOV R0,(R1)+ ;SAVE AS PREVIOUS BLOCK
SEC
BEQ 3$ ;RETURN CARRY SET IF END
BPL 1$
NEG R0
1$: CALL S.RD1 ;READ 1 BLOCK
MOV @R1,R0 ;POINT TO BUFFER LOAD
TST -(R1) ;CHECK DIRECTION
BMI 4$
MOV (R0)+,-(R1) ;SAVE NEXT BLOCK NUMBER
BR 5$
4$: ADD #512.,R0
MOV -(R0),-(R1)
5$: CLC
3$: MOV (SP)+,R1 ;RESTORE R1
RETURN
PPSCAN: TSTB -1(R1) ;ANYTHING THERE?
BEQ 1$ ;NO, RETURN 0
CALL OCTBIN ;CONVERT SOME
CMPB @R1,#054 ;IS IT A COMMA?
BNE 90$
SWAB R0 ;PUT IN TOP HALF
BNE 90$
MOV R0,-(SP) ;SAVE IT
CALL OCTBIN
TSTB @R1 ;DID WE END RIGHT?
BNE 90$
BIS R0,@SP ;SET THE NUMBER TOGETHER
SWAB R0 ;WAS IT IN RANGE ?
BNE 90$ ;NO
MOV (SP)+,S.PPDF ;SAVE AS NEW DEFAULT
1$: RETURN
90$: ERR BAPP, ;BAD PPN
OCTBIN: CLR -(SP) ;CONVERT OCTAL NUMBER TO BINARY
1$: MOVB -(R1),R0 ;GET NEXT BYTE
SUB #'8,R0 ;CHECK RANGE
ADD #8.,R0
BCC 2$ ;OUT OF RANGE
ASL @SP
ASL @SP
ASL @SP
BIS R0,@SP
BR 1$
2$: MOV (SP)+,R0
RETURN
.SBTTL TOPS-10 FILE NAME SCAN UTILITY
; THIS ROUTINE SCANS AN ASCII STRING AND CONVERTS IT TO
; A SIXBIT FILE NAME IN FILNM
; ON ENTRY, R2 -> STRING
; USES ALL REGS
T.SCAN: JSR R1,SAVREG ;SAVE REGISTERS
MOV #6,R4 ;GET A HANDY CONSTANT
MOV R4,R0 ;6 WORD BLOCK
MOV #FILNM+12.,R1 ;CLEAR BLOCK
1$: CLR -(R1)
DEC R0
BNE 1$
2$: MOV R4,R3 ;6 CHAR. NAME
3$: MOV R4,R0 ;6 BIT SHIFT
CALL SHIFT1
SUB R4,R1 ;REPOINT TO LOW BYTE
CALL CKDEL ;CHECK FOR DELIMITER
BEQ 4$
MOVB (R2)+,R5 ;GET THE BYTE
ADD #40,R5 ;CONVERT TO SIXBIT
BIC #177700,R5 ;CLEAN IT UP
BIS R5,@R1 ;STUFF IT UP
4$: DEC R3 ;6 CHARS YET?
BNE 3$
CALL CKDEL ;CHECK FOR DELIM.
BNE FNERR ;NONE => NAME ERROR
BCS RTSPC ;NO . => DONE!
INC R2 ;PUSH PAST .
CMP #FILNM,R1 ;JUST FINISHED FILNAM
BNE FNERR
ADD R4,R1 ;POINT TO EXTENSION
BR 2$
RTSPC: RETURN
FNERR: ERR FINA ;FILE NAME ILL FORMED
FILNM: .BLKW 6
CKDEL: CMPB @R2,#'. ;CHECK DELIMITER
BEQ 2$
CMPB @R2,#'/
BEQ 1$
CMPB @R2,#'=
BEQ 1$
TSTB @R2
1$: SEC
2$: RETURN
.SBTTL TOPS-10 DIRECTORY SEARCH UTILITY
; THIS ROUTINE LOOKS UP THE 6BIT FILE NAME IN FILNM
; IN THE PDP-10 DIRECTORY
; ARGUMENTS - R4 MUST CONTAIN A *.* FLAG WORD
; RETURNS R1 POINTING TO THE FILE NAME DIRECTORY ENTRY
; R2 CONTAINING THE FILE NUMBER
; WHEN CALLED AT T.NXL, LOOK UP NEXT MATCHING ENTRY
; HERE, R1 AND R2 MUST CONTAIN PREVIOUS MATCH VALUES
; NO MATCH RETURNS WITH CARRY SET
T.LOOK: MOV (PC)+,R1 ;POINT TO DIRECTORY
T.DBUF: .WORD 0
ADD #82.*6,R1 ;MOVE TO FILE NAMES
CLR R2 ;CLEAR FILE NUMBER
T.LK1: INC R2 ;NEXT FILE
ADD #6,R1
MOV R1,-(SP) ;HOLD ON FOR A MINUTE
MOV (R1)+,R0 ;CHECK FOR 0 FILE NAME BY OR-ING BITS
BIS (R1)+,R0
BIS (R1)+,R0
BEQ T.NXL1 ;0 => FILE SLOT EMPTY
MOV #FILNM,R0 ;POINT TO PROTOTYPE
TSTB R4 ;IS THE FILE NAME * ?
BNE T.LK2 ;YES, ASSUME MATCH
CMP -(R1),(R0)+ ;3 WORD MATCH
BNE T.NXL1
CMP -(R1),(R0)+
BNE T.NXL1
CMP -(R1),(R0)+
BEQ T.LK3 ;GO IF FILE NAME MATCHES
T.NXL1: MOV (SP)+,R1 ;RESTORE FILE POINTER
T.NXL: CMP #21.,R2 ;END OF DIRECTORY ?
BHIS T.LK1 ;NO, TRY AGAIN
MATCH: RETURN ;RETURN, MAYBE WITH CARRY SET
T.LK2: ADD #6,R0 ;FILE WAS *, SO BUMP PROTOTYPE PTR
T.LK3: MOV (SP)+,R1 ;FILNAM MATCHES, RESTORE PTR
TST R4 ;IS THE EXTENSION * ?
BMI MATCH ;YEAH, GOT IT
MOV 22.*6+2(R1),@R0 ;GET MOST OF THE BITS
BIC #3,@R0 ;CLEAR JUNK
CMP (R0)+,(R0)+ ;MATCH ?
BNE T.NXL ;BAH, NO GOOD
CMP 22.*6(R1),@R0 ;4 MORE BITS OK ?
BEQ MATCH
BR T.NXL ;TRY AGAIN
.SBTTL TOPS-10 EXPAND INPUT LIST
; THIS ROUTINE IS CALLED FROM THE MAIN DRIVER TO EXPAND *.*
; CONSTRUCTIONS AND TO LOOK UP IN THE DIRECTORY.
; IT ALLOCATES BUFFERS AND CREATES IN-CORE BLOCKS FOR EACH FILE
; INPUT:R5 -> AVAILABLE CORE (1ST WORD IS DSTATUS)
; R4 = *.* FLAG (LOW BYTE NON-0 IS FILNAM, R4 < 0 IS EXT)
; R3 -> 4 WORDS : RAD50 OF DEV FIL NAM EXT
; R2 -> FILE NAME STRING IN ASCII, TERMINATED BY / OR 0
;,OUTPUT:R5 -> NEXT AVAILABLE CORE LOCATION
; R3 -> FILE NAME BLOCKS
; SAVBLK= BLOCK # ON TAPE WHERE FILE MIGHT START
; FILE NUMBER (1 TO 21.)
; SIZE ESTIMATE
; DATE (TOP 4 BITS JUNK)
; (UNUSED)
T.EXPA: CMP @R5,#100001 ;IS THIS A DECTAPE?
BNE ILLDEV ;IF NOT, DEVICE NOT SUPPORTED
MOV (R3)+,R1 ;GET DEVICE NAME
SUB (PC)+,R1 ;IS IT MERELY DT
.RAD50 /DT /
BEQ 10$ ;GOT NUMBER IF SO
SUB (PC)+,R1 ;GET DEVICE NUMBER
.RAD50 / 0/
BMI ILLDEV
CMP R1,#7
BHI ILLDEV
10$: MOVB R1,T.UNIT ;ALL THAT FOR A LOUSY BYTE
MOV R5,T.DBUF ;WE JUST ALLOCATED A DIR. BUFFER
MOV R5,T.BUFF ;WE WANT TO READ INTO IT
MOV SP,FULLIO ;FORCE READING OF ALL BITS
MOV #100.,R0 ;BLOCK 100 IS THE DIRECTORY
CALL T.RDTP
ADD #128.*6,R5 ;FREE CORE BUMPED OVER DIR
MOV R5,R3 ;SAVE DESCRIPTORS PTR
CALL T.SCAN ;CONVERT FILE NAME TO 6BIT
CALL T.LOOK ;GO LOOK UP THE FILE NAME
BCS T.ENEX ;NONE, GO EXIT
1$: MOV #6,-(SP) ;PUSH A COUNTER
JSR R0,BYTSET ;SET BYTE GETTER TO FILE OR EXT
.WORD 6 ;6 BIT BYTES
3$: CALL GETBYT ;GET A BYTE
ADD #40,R0 ;6BIT CONVERSION
CALL R50PAK ;PACK UP IN RADIX 50
DEC @SP ;COUNT DOWN
BVS 5$ ;OVERFLOW MEANS DONE EXT
BNE 3$ ;NON-0 MEANS MORE FILE NAME
MOV #100002,@SP ;SET 3 BYTES FOR EXT
ADD #21.*6,BUFPTR ;MAKE BYTE GETTER GET EXTENSION
BR 3$ ;GET EXTENSION
5$: MOV R1,@SP ;NOW SAVE R1 FOR NEXT T.LOOK
MOV BUFPTR,R0 ;WE NOW GET THE DATE WORD
MOV -(R0),-(SP) ;AND SAVE IT ON THE STACK
MOV T.DBUF,DPOINT ;INITIALIZE SLOT SCANNER
MOV #100.,R0 ;START AT SLOT 100
JSR R5,DEXPLD ;EXPLODE FIRST WORD
.WORD 14.*6,6
6$: JSR R5,DSLOT ;GET A SLOT
BCS ERRDIR ;NOT FOUND ERROR
CMPB R2,@R1 ;IS THIS THE FILE
BNE 6$
MOV R0,(R5)+ ;SAVE TAPE BLOCK #
MOV R2,(R5)+ ;SAVE FILE NUMBER
CLR @R5 ;COUNT # BLOCKS FOR ESTIMATE
7$: CMPB R2,@R1 ;COUNT MATCHES
BNE 8$ ;NO HIT
INC @R5 ;HIT
8$: JSR R5,DSLOT ;NEXT TRY
BCC 7$ ;CONTINUE IF GOT
TST SWT.I ;IMAGE XFER?
BNE 9$ ;YES.127BY/BLK=> EST BLK+3/4
TST SWT.A ;IS IT ASCII?
BEQ 11$ ;MUST BE PACKED
MOV @R5,-(SP) ;ESTIMATE #*10+7/8
ASL @R5
ASL @R5
ADD (SP)+,@R5
9$: ADD #3,@R5
ASR @R5
ASR @R5
11$: TST (R5)+ ;MOVE PAST SIZE
MOV (SP)+,(R5)+ ;RETRIEVE & STORE DATE
TST (R5)+
MOV (SP)+,R1 ;RESTORE POINTER
CALL T.NXL ;AND FIND OTHER MATCHES
BCC 1$ ;GOT ONE. GO BACK
T.ENEX: CLR (R5)+ ;MARK END OF LIST
MOV R5,T.BUFF ;MAKE A DATA BUFFER
ADD #514.,R5 ;ALLOCATE BUFFER SIZE
MOV SWT.A,FULLIO ;SET WHETHER WE WANT ALL BITS
BEQ 12$ ;NO ASCII MEANS PARTIAL READ
ADD #254.,R5 ;ASCII => 128.*6 BYTES
12$: RETURN
ILLDEV: ERR ILDE ;ILLEGAL DEVICE TYPE
ERRDIR: ERR DIER, ;DIRECTORY ERROR
.SBTTL TOPS-10 READ BUFFER LOAD (IMAGE OR PACKED)
; THIS ROUTINE READS AS MANY 10 BLOCKS AS NEEDED TO FILL
; THE OUTPUT BUFFER
T.RNX: CALL T.LINK ;LINK TO NEXT BLOCK
BCC T.READ ;PROCESS IF PRESENT
BIT #1,R4 ;DON'T LEAVE HIM ODD
BEQ 1$
BICB @R4,(R4)+ ;SNEAKY WAY TO LEAVE CARRY ON
1$: RETURN
T.READ: MOV BUFPTR,R0 ;GET POINTER INTO BUFFER
ADD CPYMOD,PC ;GO TO CORRECT MODE ROUTINE
BR 1$ ;NO MODE = PACKED
BR T.RDAS ;ASCII = 2
BR T.RDIM ;IMAGE = 4
; BR 1$ ;PACKED = 6
1$: DEC BYTCTR ;DECREMENT GENERAL COUNTER
BMI T.RNX ;NO MORE, TRY TO READ
MOV (R0)+,(R4)+ ;MOVE IN A WORD
CMP R4,R5 ;TOP OF BUFFER YET?
BLO 1$
T.REX: MOV R0,BUFPTR ;SAVE WHERE WE STOPPED
RETURN ;NOTE NON-LO IS CLEAR CARRY
; READ IMAGE MODE, ONE BYTE OUT OF EACH FOUR
T.RDIM: DEC BYTCTR ;COUNT IT DOWN
BMI T.RNX ;CONTINUE IF NONE
TST (R0)+ ;SKIP BAD STUFF
MOVB (R0)+,(R4)+
INC R0
CMP R4,R5 ;ARE WE DONE?
BLO T.RDIM ;NO, CONTINUE
BR T.REX ;YES, RETURN
; READ ASCII MODE, 5 7-BIT BYTES PER WORD
T.RDAS: DEC BYTCTR ;ANY MORE ?
BMI T.RNX ;NO, TRY FOR ANOTHER BLOCK
CALL GETBYT ;GET A BYTE
MOVB R0,(R4)+
CMP R4,R5
BLO T.RDAS
RETURN
.SBTTL TOPS-10 DIRECTORY LIST LINE
T.DIR: MOV 6(R3),R0 ;GET DATE IN R0
BIC #170000,R0 ;ISOLATE GOOD BITS
CLR -(SP) ;CLEAR DATE ASSEMBLY WORD
; NOTE DATE IS IN FORMAT ((Y-64)*12.+M-1)*31.+D-1
JSR R5,DIVIDE
.WORD 31.
1$: ADD #40,@SP ;CONVERT REMAINDER TO RT-11 DAY
DEC R1
BPL 1$
JSR R5,DIVIDE
.WORD 12.
2$: ADD #2000,@SP
DEC R1
BPL 2$
ADD (SP)+,R0
RETURN
.SBTTL TOPS-10 LOOKUP (REOPEN) FILE
; LOOKS UP FILE, GETS FIRST BLOCK IN CORE
; R3 -> EXPANDED INPUT LIST
; ALSO SETS BYTCTR TO CORRECT NUMBER OF ITEMS IN BLOCK
; ACCORDING TO THE MODE OF THE TRANSFER
; DESTROYS R0,R1
T.LKUP: MOV @R3,R0 ;RETRIEVE BLOCK NUMBER
MOV R0,-(SP) ;SAVE THE NUMBER
CALL T.RDTP ;GET THE BLOCK IN
MOV R0,R1 ;POINTER TO INPUT BUFFER
TST (R1)+ ;ASSEMBLE LINK TO 1ST BLOCK
MOV (R1)+,R0 ;2 BITS HERE
SWAB R0
BIC #176377,R0
BISB 1(R1),R0 ;FIRST BLOCK NO IN R0
CMP R0,(SP)+ ;DID WE HIT?
BEQ T.SETU ;YEAH, JUST SET UP READ
T.NXRD: CALL T.RDTP ;READ THE BLOCK INTO CORE
T.SETU: MOVB (R1)+,R0 ;GET WORDS USED
INC R1 ;ADVANCE TO GOOD DATA
JSR R0,BYTSET ;SET POINTER
.WORD 7 ;7 BIT BYTES
TST SWT.I ;THAT'S IT IF IMAGE MODE
BNE 2$
MOV R0,-(SP)
TST SWT.A ;IF ASCII THEN *5, ELSE *2
BEQ 1$
ASL R0
ASL R0
1$: ADD (SP)+,R0 ;WHICH IS WHAT WE DID
2$: MOV R0,(PC)+ ;SET GENERAL PURPOSE CTR
BYTCTR: .WORD 0
RETURN ;EXIT
; CALL T.LINK TO ASSEMBLE FORWARD LINK AND READ NEXT FILE BLOCK
; RETURNS WITH CARRY SET FOR END-OF-FILE
T.LINK: MOV T.BUFF,R1 ;POINT TO INPUT BUFFER
TST (R1)+ ;ADVANCE TO LINK FIELD
MOV (R1)+,R0 ;GET FORWARD LINK
ASR R0
ASR R0
BNE T.NXRD ;AND IF NOT 0, GO READ IT
SEC ;ELSE SET CARRY FOR FAILURE
RETURN ;AND EXIT
.SBTTL TOPS-10 DIRECTORY SLOT SCANNER
; THIS ROUTINE WILL SCAN THE SLOTS IN THE DIRECTORY
; FROM 99 TO 1 AND THEN FROM 101 TO 577.
; IT RETURNS THE ASSOCIATED BLOCK # IN R0, AND A POINTER
; TO A BYTE CONTAINING THE FILE ID IN R1
DSLOT: MOV (PC)+,R1 ;SET POINTER TO EXPLODED BYTE
DIRPTR: .WORD 0
MOV (PC)+,R0
BLOCKN: .WORD 0 ;LAST BLOCK EXAMINED
CMP R0,#100. ;BACKWARDS OR FORWARDS?
BLOS 4$ ;BACK TO THE SHADOWS
CMP #576.,R0 ;DID WE JUST GIVE HIM 577?
BLO 3$ ;IF SO, RETURN WITH CARRY SET
INC R0 ;BUMP BLOCK #
INC R1 ;NEXT SLOT FORWARD
TSTB @R1 ;END OF EXPLODED WORD?
BPL DRTS5 ;NO, BUMP AND RETURN
JSR R5,DEXPLD ;GO EXPLODE ANOTHER WORD
.WORD 6.,7 ;AND RESCAN FROM END-7 = 1ST BYTE
3$: RTS R5 ;RETURN
4$: DEC R0 ;BACKWARDS - DECREMENT BLOCK #
BNE 5$ ;DID WE RUN INTO BLOCK 0?
MOV #101.,R0 ;START UPWARD AT 101
JSR R5,DEXPLD ;EXPLODE WORD 14
.WORD 14.*6,5
RTS R5
5$: TSTB -(R1) ;ARE THERE BYTES LEFT HERE?
BPL DRTS5 ;OK, JUST RETURN
JSR R5,DEXPLD ;GO EXPLODE A WORD
.WORD -6,1 ;ONE LOWER, START AT END
RTS R5
DEXPLD: ADD (R5)+,(PC)+ ;MOV BUFFER POINTER
DPOINT: .WORD 0
MOV DPOINT,R1 ;PREPARE FOR BYTER
JSR R0,BYTSET ;SET BYTE GETTER
.WORD 5 ;5 BIT BYTES
MOV R0,-(SP) ;SAVE WORD
MOV #DEXBUF+1,R1 ;POINT TO EXPLOSION SITE
1$: CALL GETBYT ;GET A BYTE
MOVB R0,(R1)+ ;PLACE IT
TSTB @R1 ;BUFFER FULL?
BPL 1$ ;GET MORE IF NOT
SUB (R5)+,R1 ;REPOINT TO STARTING BYTE (AND CLEAR CARRY)
MOV (SP)+,R0 ;RESTORE R0
DRTS5: MOV R0,BLOCKN ;SET CURRENT BLOCK
MOV R1,DIRPTR ;REMEMBER WHERE TO CONT.
RTS R5 ;GO HOME
DEXBUF: .BYTE -1,0,0,0,0,0,0,0,-1
.EVEN
.SBTTL GETBYTE AND SHIFT ROUTINES
; BYTSET IS CALLED TO INITIALIZE GETBYT
; R1 MUST POINT TO THE WORD IN WHICH BYTES ARE STORED
; THE WORD AFTER THE JSR R0 MUST CONTAIN THE BYTE SIZE
BYTSET: MOV R1,BUFPTR ;SET POINTER TO WORD
CLR BITCTR ;FORCE A WORD FETCH
CLR R50CTR ;IT'S USEFUL HERE.
MOV (R0)+,BYTSIZ
RTS R0
; GETBYT RETURNS BYTES IN R0. (OTHER REGS PRESERVED)
; IF NOT ENOUGH BYTES REMAIN IN THE CURRENT WORD,
; THE BUFFER POINTER IS ADVANCED.
; WARNING - IT NEVER GIVES AN ERROR. THE CALLER
; MUST COUNT.
GETBYT: MOV R1,-(SP) ;SAVE REGISTER
MOV #BYTSIZ,R1 ;PREPARE TO COUNT DOWN BITS
GETBY1: MOV @R1,R0 ;HOLD ON TO BYTE SIZE
SUB R0,-(R1) ;SUBTRACT BYTE SIZE FROM BIT CTR
BPL GETBY2 ;GO IF THERE ARE BITS LEFT
MOV (PC)+,R0 ;R0 POINTS INTO DATA BUFFER
BUFPTR: .WORD 0
MOV (R0)+,-(R1)
MOV (R0)+,-(R1)
MOV (R0)+,-(R1)
MOV R0,BUFPTR
MOV #4,R0 ;PRENORMALIZE BY 4 BITS
CALL SHIFT1 ;GO DO IT (R1 ALREADY POINTS TO BOTTOM)
MOV #36.,(R1)+ ;RESET COUNTER
BR GETBY1
GETBY2: MOV #RTS1,-(SP) ;SET UP RETURN FUDGE
; SHIFT SHIFTS A THREE WORD ENTITY LEFTWARD
; THE THING IS ASSUMED TO BE BACKWARD IN CORE WORDWISE.
; R0 MUST CONTAIN THE SHIFT COUNT, R1 POINT TO THE WORD
; PAST THE END OF THE ENTITY.
; THE BYTE SHIFTED OUT INTO THE ENDMOST POSITION IS RETURNED
; IN R0.
; R1 IS LEFT POINTING TO THE END OF THE BUFFER
SHIFT: SUB #6,R1 ;POINT TO LOW ORDER BITS
SHIFT1: ASL (R1)+
ROL (R1)+
ROL (R1)+
DEC R0 ;SHIFTED ENOUGH YET?
BNE SHIFT
BISB -(R1),R0 ;R0 IS 0. GET THE BYTE
CLRB (R1)+ ;CLEAR IT FOR NEXT TIME
RETURN
BYTBUF: .BLKW 3
BITCTR: .WORD 0
BYTSIZ: .WORD 0
.SBTTL RADIX 50 PACKER
; PACKS CHARACTERS INTO @R5, 3 PER WORD
; CALLED WITH CHARACTER IN R0, WHICH IT DESTROYS
R50PAK: DEC (PC)+ ;COUNT DOWN FROM 3
R50CTR: .WORD 0
BGT 1$ ;SPACE LEFT, SO GO *50
CLR (R5)+ ;CLEAR THE NEXT WORD
MOV #3,R50CTR ;RESET COUNT
1$: SUB #72,R0 ;CHECK FOR DIGIT
ADD #12,R0
BCC 2$ ;NO, GO TRY FOR LETTER
ADD #36,R0 ;SCALE DIGIT
BR 4$
2$: SUB #20,R0 ;REDUCE TO LETTER RANGE
BLE 3$ ;DELIMITER!
CMP R0,#32 ;A TO Z?
BLE 4$ ;GOT IT
SUB #40,R0 ;MAY AS WELL TRY LOWER CASE
BGT 2$
3$: CLR R0 ;CALL IT A SPACE
4$: ASL -(R5) ;*50+CHAR
ASL @R5
ASL @R5
ADD @R5,R0
ASL @R5
ASL @R5
ADD R0,(R5)+ ;KEEP POINTING PAST IT
RETURN
.SBTTL READ BLOCK FROM PDP-10 TAPE
; ROUTINE TO READ A BLOCK FROM A PDP-10 DECTAPE
; INTO AREA POINTED TO BY T.BUFF
; R0 = BLOCK NUMBER. R0 IS DESTROYED.
T.RDTP: CLR -(SP) ;GO INTO SYSTEM STATE
CALL 1$ ;SO THAT TIMER TICKS ARE VERY FAST
TST DTERR ;GOT DECTAPE ERRORS?
BNE RTS0 ;NO
ERR INER ;YUP, HOW TERRIBLE
1$: .MTPS #340 ;UP TO PRIORITY 7 ;###
JSR R5,@54 ;TO YE SYSTEM
.WORD 340 ;AT PRIORITY 0
MOV SP,DTERR ;SAVE CURRENT SP, SAY NO ERROR
CALL SEARCH ;POSITION THE DECTAPE
MOV R1,-(SP)
MOV R2,-(SP)
MOV (PC)+,R2 ;POINTER TO EXTRA BIT BUCKET
T.BUFF: .WORD 0
MOV R2,-(SP) ;SAVE BUFFER PTR
MOV #-256.,R1 ;SET UP WORD COUNT
MOV #TCDT,R0 ;POINT FOR FILLER
MOV R2,-(R0) ;STUFF BUS ADDRESS
MOV R1,-(R0) ;STUFF WORD COUNT
TST -(R0) ;POINT RIGHT FOR BYTE
.MTPS #340 ;WE MUST NOT BE INTERRUPTED!!! ;###
MOVB #5,@R0 ;SET YE COMMANDE GOING
1$: ADD #2,4(R0) ;POINT THE CONTROLLER TO GIVE ME ROOM
CLR @R2 ;UNUSED BITS MUST BE 0
CALL TWAIT ;WAIT FOR READY WORD OR ERROR.
ASL @R2 ;MAKE ROOM WITH LONG LEFT 2
ROL -(R2)
ASL 2(R2)
ROL (R2)+
CALL TWAIT ;WAIT FOR A WORD
TST (R2)+ ;SKIP OVER THE GOOD WORD
TST R1 ;ARE WE DONE (EVEN COUNT) ?
BGE 3$ ;YES, CEASE THIS STUFF
TST (PC)+ ;DO WE WANT ALL BITS?
FULLIO=.
.WORD 0
BNE 1$ ;YES, GO EAT
.MTPS #0 ;DOWN AGAIN TO PRI. 0 ;###
2$: BIT #100200,@R0 ;NO, JUST WAIT FOR COMPLETION
BEQ 2$
BMI HARDER
3$: .MTPS #0 ;DOWN TO 0 IF FULLIO ON ;###
MOV T.UNIT,R1 ;A CONVENIENT STOP SEL TRANS
SWAB R1 ;FIX IT UP
MOV R1,@R0 ;STOP IT!!
MOV (SP)+,R0 ;PASS HIM THE BUFFER ADDRESS
RTS2: MOV (SP)+,R2
RTS1: MOV (SP)+,R1
RTS0: RETURN
TWAIT: TST @R0 ;CHECK FOR ERROR
BMI HARDER ;STOP IF SO
CMP R1,2(R0) ;IS A WORD READY?
BEQ TWAIT ;NO, KEEP LOOPING
MOV @#TCST,-(SP) ;GET EXTRA BITS
BIC #177774,@SP ;REMOVE JUNK
BIS (SP)+,(R2)+ ;ENBUFFER IT
INC R1 ;BUMP WORD COUNT
RETURN
.SBTTL SEARCH DECTAPE
; ROUTINE TO LOCATE A BLOCK ON DECTAPE
; R0 -> BLOCK TO FIND ON DECTAPE
SEARCH: MOV R0,-(SP)
MOV #TCCM,R0
T.UNIT=.+2 ;ASSEMBLER CAN'T HANDLE THIS
MOVB #4400,1(R0) ;SET CORRECT UNIT NUMBER
; NOTE THAT THIS CONSTANT SERVES AS A STOP TRANSPORT
; WHEN IT IS SWAB-ED.
CMP @SP,(PC)+ ;WHICH WAY TO TRY?
BPREV: .WORD 0
BHI 4$ ;TRY FORWARDS
1$: SUB #3,@SP
BIS #4000,@R0 ;SET REVERSE.
15$: MOVB #3,@R0 ;START A SEARCH
2$: BIT #100200,@R0
BEQ 2$
BMI 10$
CMP @SP,@#TCDT
BLT 15$
3$: ADD #3,@SP
BIC #4000,@R0
4$: MOVB #3,@R0
5$: BIT #100200,@R0
BEQ 5$
BMI 10$
CMP @SP,@#TCDT
BGT 4$
BLT 1$
BIS #10000,@R0 ;GIVE THE GUY A RUNNING START
MOV (SP)+,BPREV ;REMEMBER WHERE WE ARE
RETURN
10$: TST @#TCST
BPL HARDER
BIT #4000,@R0
BNE 3$
BR 1$
HARDER: .MTPS #0 ;DOWN TO 0 IF NEED BE ;###
CLR @#TCCM
MOV (PC)+,SP ;RESET STACK
DTERR: 0
CLR DTERR ;REMIND USER JOB THAT WE GOT ERROR
RETURN ;BACK TO THE SHADOWS AGAIN
.SBTTL INITIALIZATION
LIST NOTIMP R
LIST NOTIMP T
LIST NOTIMP S
ERR FENOIM,
FREE: ;BUFFER OVERLAYS THIS
BEGIN: MOV @#SYSPTR,R2 ;POINT TO SYSTEM
ADD #OFFSET-8.,R2 ;POINT TO DEPENDENT STUFF
MOV R2,BLKEY ;SAVE BLKEY PTR
TST (R2)+
MOV R2,CHKEY
ADD #6,R2
MOV @R2,R0 ;POINT TO USR BOTTOM
MOV R0,USRBUF
TST -(R0) ;FIX FOR SETTOP
.SETTO
SUB #256.*6-2,R0 ;COMPUTE WHERE THE DOS DIRECTORY COMES IN
MOV R0,S.DBUF
ADD #256.*4+8.,R0 ;COMPUTE WHERE ITS BIT MAP GOES
MOV R0,S.BMAP
.DATE
MOV R0,DATE ;SAVE TODAY'S DATE
BEQ 6$ ;DON'T BE FOOLISH
BIT #3,R0 ;LEAP YEARISH ?
BNE 1$
MOVB #29.,LFEB ;YEP, FIX FEB
1$: MOV R0,-(SP) ;CONVERT DATE TO DOSSISH
BIC #177740,@SP
ASR R0
ASR R0
ASR R0
ASR R0
ASR R0
BNE 1$
MOV #2000.,R1 ;DOS IS REL 1970, RT REL 72
MOV #LMONTH,R2 ;MONTH LENGTHS
MOV (SP)+,R3 ;MONTH TO R3
2$: DEC R3
BEQ 3$
MOVB (R2)+,R4
ADD R4,R1
BR 2$
3$: ADD (SP)+,R1 ;ADD DAY
MOV (SP)+,R3 ;GET YEAR
4$: DEC R3
BMI 5$
ADD #1000.,R1
BR 4$
5$: MOV R1,S.DATE
6$: MOV #START,@#STRTAD
BIS #20000,@#JSW ;MAKE US REENTERABLE
JMP START
.END BEGIN
.TITLE SRCCOM V01-03 SOURCE FILE COMPARE UTILITY
; RT-11 SOURCE COMPARE
;
; DEC-11-OSRCA-E
;
; EP,ABC,DTW
;
; COPYRIGHT (C) 1974,1975
;
; DIGITAL EQUIPMENT CORPORATION
; MAYNARD, MASSACHUSETTS 01754
;
; THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY
; ON A SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH
; THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE,
; OR ANY OTHER COPIES THEREOF, MAY NOT BE PROVIDED OR OTHERWISE MADE
; AVAILABLE TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO
; ONE WHO AGREES TO THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE
; SOFTWARE SHALL AT ALL TIMES REMAIN IN DIGITAL.
;
; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO
; CHANGE WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED
; AS A COMMITMENT BY DIGITAL EQUIPMENT CORPORATION.
;
; DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE
; OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT
; WHICH IS NOT SUPPLIED BY DIGITAL.
;
.MCALL ..V1..
..V1..
.MCALL .CLOSE, .CSIGEN,.PRINT, .RCTRLO,.SETTOP,.SRESET,.TTYOUT
.MCALL .WAIT, .WRITE
.MACRO CALL SUBR
JSR PC,SUBR
.ENDM CALL
.MACRO RETURN
RTS PC
.ENDM RETURN
.MACRO SERROR CODE,MSG
JSR R0,SERROR
.ASCIZ /?MSG?/
.EVEN
.ENDM SERROR
.SBTTL PROGRAM START
R0 = %0
R1 = %1
R2 = %2
R3 = %3
R4 = %4
R5 = %5
SP = %6
PC = %7
INITSP = 42 ;INITIAL STACK POINTER
JSW = 44 ;JOB STATUS WORD
ERRLOC = 52 ;ERROR BYTE
RMON = 54 ;LOCATION OF MONITOR
USRBUF = 266 ;OFFSET OF POINTER TO USR BUFFER
LF = 12 ;CONSTANTS
FF = 14
CR = 15
SPACE = 40
TAB = 11
SEMICL = 73
RENTR = 20000 ;JOB-IS-REENTERABLE BIT
HELP: MOV #HLPMSG,R0 ;HELP THE POOR GUY
SERROR: .PRINT ;PRINT THE ERROR MESSAGE
BR CONT ;CONTINUE (OR REENTER)
START: MOV @#RMON,R0 ;POINT TO MONITOR
MOV USRBUF(R0),R0 ;LEAVE USR RESIDENT
TST -(R0) ;FIX FOR SETTOP
.SETTOP
TST (R0)+ ;FIX FROM SETTOP
MOV R0,HIEND ;SAVE TOP OF CHICKEN AREA
SUB #LINLEN,R0 ;LEAVE CHICKEN FACTOR
MOV R0,HIFREE ;SAVE TOP OF CORE
BIS #RENTR,@#JSW ;REENTERABLE
CONT: MOV @#INITSP,SP ;RESET STACK
CLR R1 ;CLEAR ALL SWITCHES
.SRESET ;PURGE CHANNELS
.RCTRLO ;TALK LOUDLY
.CSIGEN #PGMTOP,#DEFEXT,#0 ;GET A COMMAND LINE
MOV #LOFREE,R2 ;POINT R2 AT IMPURE AREA
MOV R0,(R2)+ ;SAVE START OF FREE CORE
MOV R0,(R2)+ ;AND INITIALIZE FREE SPACE PTR
.WAIT 0 ;IS OUTPUT TO THE TTY?
ROR R1 ;INDICATE TELETYPE OUTPUT IF NOT
.SBTTL MAIN PROGRAM
MOV #3,@R2 ;NUMBER OF LINES WHICH MUST MATCH - 1
MOV (SP)+,R0 ;POP SWITCH COUNT
BEQ 7$
1$: MOV (SP)+,R5 ;GET LETTER
BMI 4$ ;BAD IF VALUE
MOV #SWTTBL,R4 ;POINT TO TABLE OF LEGAL SWITCHES
MOV #1,R3 ;FIRST SWITCH BIT
2$: CMPB (R4)+,R5 ;RIGHT?
BEQ 5$
ASL R3 ;NEXT FLAG BIT
TSTB @R4 ;END OF TABLE?
BNE 2$ ;NOT YET
3$: SERROR SWT,
4$: CMPB #'L,R5 ;ONLY /L CAN TAKE A VALUE
BNE 3$ ; AND IT ISN'T THAT
MOV (SP)+,@R2 ;SET NUMBER OF LINES THAT MUST MATCH
BR 6$
5$: BIS R3,R1 ;SET FLAG IN SWITCH
6$: DEC R0 ;MORE?
BGT 1$
7$: BIT #SWHELP,R1 ;IS HE CONFUSED?
BNE HELP ;YES. HELP HIM OUT
CLR STBIT ;SET NOT TO IGNORE SPACES & TABS
BIT #SWCMNT+SWSPTB,R1 ;SHOULD WE IGNORE THEM?
BEQ 8$ ;NO
MOV #200,STBIT ;YES
MOV #77777,R0 ;SET CMNTCH TO INCLUDE COMMENTS
BIT #SWCMNT,R1 ;INCLUDE THEM?
BEQ 8$ ;YES
MOV #SEMICL,R0 ;NO
8$: DEC @R2 ;ADJUST
CMP (R2)+,#TABLEN ;IS HE ASKING FOR TOO MANY TO MATCH?
BHI 3$ ;YEP
MOV R0,CMNTCH ;SET FLAG
MOV R1,(R2)+ ;SAVE SWITCHES
CLR (R2)+ ;OUTPUT FILE BLOCK NUMBER
MOV #OBUF1,(R2)+ ;OUTPUT POINTER
MOV OBUF2-2,(R2)+ ;END-OF-BUFFER POINTER
MOV #NODIF,(R2)+ ;MESSAGE IS 'NO DIFFERENCES'
MOV #CHAN1,R0 ;INITIALIZE CHANNELS
9$: MOV TBLPTR(R0),R1 ;COPY CHANNEL POINTER
MOV R1,@R0 ;INITIALIZE C
MOV R1,T(R0) ; AND T
CLR EOF(R0) ;NO EOF YET
CLR BLKNO(R0) ;START AT BLOCK 0
MOV #1,PAGE(R0) ;START ON PAGE 1
MOV BUFEND(R0),INPTR(R0) ;START AT BEGINNING OF BUFFER
MOV -(R0),R0 ;POINT TO NEXT CHANNEL
BNE 9$ ;GOT IT. DO CHANNEL 2
CALL GET2 ;GET 2 LINES FROM FILES
BNE FINI ;YES
JSR R0,PRTEXT ;PRINT FROM CHANNEL 1
.WORD CHAN1
JSR R0,PRTEXT ;AND NOW FROM 2
.WORD CHAN2
CALL COMPC ;DTW-CHECK FOR DIFFERENCE IN FIRST 2 LINES
BEQ DTW001 ;DTW-NO DIFFERENCE
MOV #YESDIF,DIFMSG ;DTW-SET THE MESSAGE TO TELL THE WORLD
DTW001: MOV #CRLF,R0 ;AND A CRLF
CALL LIST
.SBTTL MAIN COMPARISON LOOP
; FIRST SEARCH FOR THE END OF THE CURRENT MATCH
LOOP: MOV #CHAN1,R0 ;DELETE TIRED OLD LINES
30$: MOV TBLPTR(R0),R1 ;R1 -> TABLE OF LINE POINTERS
MOV @R0,R2 ;R2 -> CURRENT LINE (LOW LIMIT)
MOV R1,(R0)+ ;RESET C TO BOTTOM OF TABLE
MOV @R0,R3 ;R3 -> TOP LINE
CMP R2,R3 ;IF CURRENT LINE = TOP LINE
BEQ 32$ ;THEN NOTHING TO MOVE
CMP (R2)+,(R1)+ ;DISCARD CURRENT LINE, POINT TO GOOD TABLE
BIT #SWBLNK,SWITCH ;ARE WE COMPARING BALNK LINES?
BNE 31$ ;YES, NO HACKS
33$: MOV @R2,R4 ;DTW-POINT TO LINE(PAGE # BYTE)
INC R4 ;DTW-POINT TO FIRST CHARACTER
CMPB @R4,#CR ;DTW-NO. IS THE LOWEST LINE NULL?
BNE 31$ ;DTW-NO, FIX R2 AND GO
TST (R2)+ ;DTW-POINT TO NEXT LINE
CMP R2,R3 ;YES. ARE WE DONE?
BLOS 33$ ;NO
BR 35$ ;YES. FIX R1 AND GET OUT (ALL NULL)
31$: MOV (R2)+,(R1)+ ;MOVE UP
CMP R2,R3 ;DONE ?
BLOS 31$ ;NO
35$: TST -(R1) ;R1 -> TOP GOOD LINE
32$: MOV R1,@R0 ;SAVE TOP GOOD POINTER
MOV -4(R0),R0 ;NEXT CHANNEL
BNE 30$ ;GO DO CH. 2
CALL GET2 ;GET 2 MORE LINES
BNE 5$ ;END OF FILE
CALL COMPC ;COMPARE LAST 2 LINES
BEQ LOOP ;THE SAME !
; FOUND A DIFFERENCE. NOW LOCATE THE NEXT MATCH
1$: MOV #CHAN1,R5 ;POINT TO CHANNEL 1
CALL GET2 ;GET A LINE FROM EACH CHANNEL
BNE 5$ ;ONE OR BOTH CHANNELS IS EMPTY
2$: MOV @R5,R4 ;R4 -> HIGHEST LINE WHICH WE HAVE GOTTEN
MOV TBLPTR(R5),@R5 ;SET CURRENT LINE TO BE
; THE BEGINNING OF THE GOTTEN LINES
3$: ADD #2,@R5 ;ADVANCE THE MOVING CHANNEL
CALL COMPC ;COMPARE NEW LINE OF OTHER CHANNEL
BNE 4$ ;IT DOESN'T MATCH THIS LINE
CALL MULTIC ;IT MATCHES. TEST FOR COMPLETE MATCH
4$: CMP @R5,R4 ;NO COMPLETE MATCH. DONE MOVING THIS?
BNE 3$ ;NO, TRY NEXT LINE
MOV -(R5),R5 ;YES. SCAN OTHER CHANNEL
BNE 2$ ;NOT DONE
BR 1$ ;NEITHER OF THE NEW LINES HIT. GET MORE
; WE REACH THIS POINT IF ONE OR BOTH FILES HAS NO MORE LINES.
; IF EOF WAS FOUND ON BOTH CHANNELS, THEN:
; IF EITHER OR BOTH CHANNELS IS NOT EMPTY, A DIFFERENCE IS PRINTED;
; THEN GET OUT
; ELSE IF ONE CHANNEL IS COMPLETELY EMPTY, THEN THE 2 FILES MATCHED
; BUT ONE WAS LONGER, SO FLUSH THE FILE WHICH STILL HAS LINES
; ELSE IF NEITHER CHANNEL IS COMPLETELY EMPTY, AND EOF ON ONLY ONE,
; WE MUST COMPARE THE ONE NEW LINE AGAINST THE DEAD CHANNEL
; TO FIND IF IT MATCHES
5$: MOV #CHAN1,R5 ;POINT TO CHANNELS
CMP #-1,R0 ;BOTH CHANNELS HAD EOF?
BEQ FINI ;YES, FLUSH BOTH
51$: CMP TBLPTR(R5),@R5 ;IS CHANNEL 1 EMPTY
BEQ 8$ ;YES. GO PRINT REST OF CH. 2
MOV -(R5),R5
BNE 51$ ;TRY OTHER CHANNEL IF ANY
MOV R0,R5 ;NO. POINT R5 TO CHANNEL TO VARY
MOV @R5,R4 ;LOOP SAME AS ABOVE, BUT ONLY ONCE
MOV TBLPTR(R5),@R5
6$: ADD #2,@R5
CALL COMPC
BNE 7$
CALL MULTIC
7$: CMP @R5,R4
BNE 6$
BR 1$ ;IF NO MATCH, GO TO 1$ TO TRY AGAIN ON
; THE CHANNEL WHICH IS NOT EOF.
8$: MOV OTHER(R5),R0 ;POINT TO CHANNEL TO BE FLUSHED
MOV R0,9$
MOV T(R0),@R0 ;FLUSH EVERY LINE WE'VE GOTTEN
JSR R0,PRTEXT
9$: 0
MOV #YESDIF,DIFMSG ;THIS IS, OF COURSE, A DIFFERENCE
BR LOOP ;AT LOOP, WE KILL THE FLUSHED LINES & READ
FINI: CMP C1,#TABL1-2 ;CHANNEL 1 EMPTY ?
BNE 10$ ;NAY
CMP C2,#TABL2-2 ;CHANNEL 2 EMPTY ?
BEQ 11$ ;DONE AT LAST
10$: CALL PRBOTH ;PRINT A DIFFERENCE
11$: .RCTRLO
.PRINT DIFMSG ;PRINT THE FINAL DETERMINATION
CMP DIFMSG,#NODIF ; AND IF THERE WERE NO DIFFERENCES,
BEQ 3$ ;EXIT WITHOUT CLOSING FILE
MOV TOAD,R4 ;PREPARE TO FLUSH OUTPUT
MOV OBUFE,R5 ;POINT TO TOP
SUB R4,R5 ;NUMBER TO FILL
CMP R5,#512. ;EMPTY BUFFER ?
BEQ 2$ ;YES, JUST CLOSE
1$: CLRB (R4)+ ;CLEAR A BYTE
DEC R5 ;ANY MORE ?
BNE 1$
CALL OUTPUT ;LAST BUFFER OUT
2$: .WAIT 0 ;QUIESCE
.CLOSE 0
3$: JMP START ;REALLY DONE
; THE REST OF THE PROGRAM IS SUBROUTINES
.SBTTL GET A LINE FROM EACH FILE
; GET A LINE FROM EACH FILE BY ADVANCING C UNTIL IT REACHES T,
; AND THEN BY READING THE INPUT FILES
GET2: CLR ENDFLG ;NO EOF YET
MOV #CHAN1,R0 ;GET A LINE FROM CHANNEL 1
GET1: CMP (R0),T(R0) ;SHOULD WE GET A LINE FROM THE FILE ?
BNE 1$ ;NO
TST EOF(R0) ;CAN WE ?
BNE 2$ ;NO
CALL READ ;YES, GET IT
BCS 2$ ;COULDN'T GET ONE
1$: ADD #2,(R0) ;ADVANCE TO NEXT LINE
BIT #SWBLNK,SWITCH ;COMPARE BLANK LINES?
BNE 4$ ;YES
MOV @(R0),-(SP) ;YES. NULL LINE?
INC @SP ;(BUMP OVER PAGE NUMBER)
CMPB @(SP)+,#CR ;?
BEQ GET1 ;IF SO, GET ANUDDER
4$: MOV -(R0),R0 ;POINT TO NEXT CHANNEL, IF ANY
BNE GET1 ;YES, GO DO CHANNEL 2
MOV ENDFLG,R0 ;NO, RETURN END OF FILE CONDITION!
RETURN
2$: TST ENDFLG ;EOF FLAG ALREADY SET ?
BEQ 3$ ;NO
MOV #-1,ENDFLG ;SET 'EOF ON BOTH' FLAG
BR 4$ ;AND LOOP
3$: MOV R0,ENDFLG ;RECORD CHANNEL WITH EOF
BR 4$ ;AND LOOP
.SBTTL READ ROUTINES
; READ A LINE FROM THE CHANNEL POINTED TO BY R0
.ENABL LSB
READ: MOV R1,-(SP) ;SAVE WHAT WE USE
MOV R2,-(SP)
MOV R3,-(SP)
MOV R4,-(SP)
MOV FRECOR,R1 ;POINT TO AVAILABLE CORE
CMP R1,HIFREE ;IS THERE ENOUGH LEFT ?
BLO 1$ ;YES
CALL PACK ;COLLECT THE GARBAGE
1$: INC R1 ;MAKE ROOM FOR PAGE NUMBER
MOV R1,R4 ;REMEMBER WHERE LINE STARTED
MOV INPTR(R0),R2 ;GET INPUT POINTER
2$: CMP R2,BUFEND(R0) ;ANY CHARS IN BUFFER ?
BHIS 5$ ;NO
3$: MOVB (R2)+,R3 ;GET A BYTE
BEQ 2$ ;DELETE NULLS
CMP #FF,R3 ;IS IT A NEW PAGE?
BEQ 20$ ;YES, DO SOMETHING ABOUT IT
CMP #SPACE,R3 ;IS IT A SPACE?
BEQ 10$ ;YES
CMP #TAB,R3 ;OR A TAB?
BNE 11$
10$: BIS (PC)+,R3 ;SET TO IGNORE IF FLAG IS ON
STBIT: 0
11$: MOVB R3,(R1)+ ;STORE IN LINE
CMP R1,HIEND ;CORE OVERFLOW ?
BHIS COROVR ;OOPS
CMP R3,#LF ;END OF LINE ?
BNE 2$ ;NO, KEEP TRUCK MOVING
8$: CMPB @R4,#CR ;DID LINE START WITH CR?
BNE 17$ ;NO, DON'T BOTHER
BIT #SWBLNK,SWITCH ;YES. ARE WE COMPARING BLANK LINES?
BNE 17$ ;YES, INCLUDE IT
CMP T(R0),TBLPTR(R0) ;NO, IS THIS THE FIRST LINE OF THE TBL?
BNE 17$ ;NO
MOV R4,R1 ;YES. DISCARD THE LINE AND GET ANOTHER
BR 2$
17$: ADD #2,T(R0) ;NEXT ENTRY IN CHANNEL TABLE
CMP T(R0),TMAX(R0) ;TOO MANY LINES?
BHIS 9$ ;YEP. BOOT HIM
MOVB PAGE(R0),-(R4) ;NOPE. SAVE PAGE NUMBER IN LINE
MOV R4,@T(R0) ;STORE POINTER TO NEW LINE
CLRB (R1)+ ;SET STOPPER (& CLEAR CARRY)
MOV R1,FRECOR ;SAVE NEW AVAILABLE CORE PTR
18$: MOV R2,INPTR(R0) ;SAVE INPOINTER
MOV (SP)+,R4 ;RESTORE STUFF
MOV (SP)+,R3
MOV (SP)+,R2
MOV (SP)+,R1
RETURN
20$: INCB PAGE(R0) ;BUMP PAGE NUMBER
BNE 11$ ;BUT ONLY KEEP A BYTE
BR 20$ ;SO PAGE 256 = PAGE 1
5$: MOV R0,-(SP) ;COPY CHANNEL NUMBER
CLR -(SP) ;USE WAIT I/O
MOV #256.,-(SP) ;WORD COUNT
MOV BUFFER(R0),R2 ;BUFFER ADDRESS
MOV R2,-(SP) ;BUFFER ADDRESS
MOV CHANNO(R0),6$ ;SET READ EMT FOR CORRECT CHANNEL
MOV BLKNO(R0),R0 ;IS THE ONE TO READ
6$: EMT 200+3 ;READ EMT FOR A CHANNEL
MOV (SP)+,R0 ;RESTORE CHANNEL
INC BLKNO(R0) ;NEXT BLOCK
BCC 3$ ;KEEP READING UNLESS ERROR
TSTB @#ERRLOC ;WAS IT EOF ?
BNE 7$ ;BADNESS
INC EOF(R0) ;SAY END OF FILE HERE
CMP R1,R4 ;DID THAT LINE GET ANYTHING?
BNE 8$ ;YES. GIVE IT TO HIM
SEC ;NO. GIVE EOF NOW
BR 18$ ;AND GET OUT WITH C=1
7$: SERROR INP,
9$: SERROR TMD,
.DSABL LSB
.SBTTL GARBAGE COLLECTOR
; PACK EVERYTHING DOWN IN CORE
PACK: MOV R0,-(SP) ;PRESERVE R0
MOV #CHAN1+TABLE,R3 ;POINT TO THE CHANNELS
MOV #CHAN2+TABLE,R2
MOV LOFREE,R1 ;START OF STRING SPACE
MOV T1,R0 ;LAST LINE OF CHANNEL 1
MOV #-1,2(R0) ;STORE AN END FLAG
MOV T2,R0 ;AGAIN
MOV #-1,2(R0)
3$: CMP @R3,@R2 ;FIND LOWEST LINE
BEQ 4$ ;THE SAME LINE BOTH PLACES
BLO 1$ ;R3 HAS LOWEST LINE
MOV @R2,R0 ;CHANNEL 2 HAS LOWEST LINE. GET IT
MOV R1,(R2)+ ;STORE NEW LINE LOC
BR 2$
1$: MOV @R3,R0 ;GET LOWEST LINE
MOV R1,(R3)+
2$: MOVB (R0)+,(R1)+ ;COPY STRING DOWN
BNE 2$ ;ASCIZ STRING ARE NICE
BR 3$ ;MORE
4$: CMP #-1,@R3 ;END ?
BNE 1$ ;NO
MOV R1,FRECOR ;SAVE NEW TOP
CMP R1,HIFREE ;SUCCESS ?
BHIS COROVR ;NO
MOV (SP)+,R0 ;RESTORE R0
RETURN
COROVR: SERROR COR,
.SBTTL OUTPUT ROUTINES
; PRINT TEXT FROM CHANNEL R0
PRTEXT: MOV (R0)+,R1 ;POINT R1 TO CHANNEL
MOV R0,-(SP) ;SAVE R0 (RETURN)
MOV @R1,R2 ;R2 -> TOP LINE TO PUT OUT
ADD #IDENT,R1 ;POINT TO LINE TABLE
MOV (R1)+,-(SP) ;SAVE POINTER TO ID STRING
CLR R3 ;FORCE PRINTING OF FIRST PAGE #
1$: MOV @SP,R0 ;PRINT THE ID STRING
MOV @R1,R4 ;GET POINTER TO STRING FOR PAGE #
TST (R0)+ ;ADVANCE OVER "1)" OR "2)"
CMPB (R4)+,R3 ;SAME PAGE AS LAST LINE?
BNE 3$ ;NO. PUT THE NUMBER IN
2$: MOVB #TAB,(R0)+ ;TERMINATE WITH TAB, NULL
CLRB (R0)+
MOV @SP,R0 ;REPOINT TO ID
CALL LIST
MOV (R1)+,R0 ;POINT TO A LINE
MOVB (R0)+,R3 ;RETAIN MOST RECENT PAGE NUMBER
CALL LIST ;PRINT IT
CMP R1,R2 ;DONE ?
BLOS 1$ ;NO
TST (SP)+ ;PURGE ID POINTER
MOV (SP)+,R0
RTS R0
3$: CLR R3 ;GET PAGE NUMBER
BISB -(R4),R3 ;(DRATTED SIGN EXTEND!)
MOV #TENTBL,R5 ;POWERS OF TEN
4$: CMP -(R5),R3 ;FIND A GOOD POWER OF 10
BHI 4$
5$: MOVB #'0-1,@R0 ;PUT IN A BYTE TO BE BUMPED
6$: INCB @R0 ;COUNT BYTE UP
SUB @R5,R3 ;COUNT PAGE # DOWN
BPL 6$ ;UNTIL < 0
ADD @R5,R3 ;FIX PAGE #
INC R0 ;BUMP POINTER
TST -(R5) ;POINT TO NEXT POWER OF 10
BNE 5$ ;IF ANY
BR 2$ ;ELSE FINISH LINE AND PRINT IT
; PRINT TEXT FROM BOTH CHANNELS
PRBOTH: MOV #YESDIF,DIFMSG ;SAY THAT A DIFFERENCE IS FOUND
JSR R0,PRTEXT ;PRINT CHAN 1
.WORD CHAN1
MOV #STARS,R0 ;SPACER
CALL LIST
JSR R0,PRTEXT ;PRINT CHAN 2
.WORD CHAN2
MOV #LSTARS,R0 ;BIG SEPARATOR
; BR LIST
; LIST PUTS A LINE TO THE OUTPUT FILE
.ENABL LSB
LIST: MOV R0,R5 ;COPY STRING POINTER
TST SWITCH ;TELETYPE OUTPUT??
BMI 6$ ;YES
MOV TOAD,R4 ;POINT TO BUFFER
1$: CMPB #FF,@R5 ;FORM FEED?
BNE 2$ ;NO
BIT #SWFORM,SWITCH ;YES. INCLUDE THEM?
BNE 2$ ;YES
INC R5 ;NO
BR 1$
2$: MOVB (R5)+,@R4 ;GET NEXT BYTE INTO BUFFER
BICB #200,(R4)+ ;TURN OFF PARITY BIT
BEQ 3$ ;END OF STRING ?
CMP R4,OBUFE ;END OF BUFFER ?
BLO 1$ ;NO, GO
OUTPUT: SUB #512.,R4 ;NO GO. POINT TO BOTTOM
.WAIT 0 ;QUIESCE CHANNEL 0
BCS 7$ ;ERROR
.WRITE 0,R4,#256.,OBLK
BCS 7$ ;ERROR
INC OBLK ;NEXT BLOCK
MOV -(R4),OBUFE ;TOP OF OTHER BUFFER
MOV -(R4),R4 ;BOTTOM OF OTHER BUFFER
BR 1$ ;GO
3$: DEC R4 ;FIX R4
MOV R4,TOAD ;SAVE POINTER
RETURN
4$: CMPB #FF,R0 ;IS IT A FEEDER OF FORMS?
BNE 5$ ;NAY
BIT #SWFORM,SWITCH ;SHOULD WE PRINT FEEDERS OF FORMS?
BEQ 6$ ;NEIGH
5$: .TTYOUT
6$: MOVB (R5)+,R0 ;GET NEXT CHARACTER IN STRING
BNE 4$ ;AND TYPE IT IF NOT NULL
RETURN
7$: SERROR OUT,
.DSABL LSB
.SBTTL SINGLE LINE COMPARISON ROUTINE
; COMPARE TWO LINES
.ENABL LSB
COMPC: MOV @C1,R1 ;GET STRING POINTERS
MOV @C2,R2
CMPB (R1)+,(R2)+ ;BUMP OVER PAGE NUMBERS
TSTB CMNTCH ;IGNORE SPACES, TABS (&COMMENTS)?
BNE 10$ ;YES, SLOWER LOOP
1$: TSTB @R1 ;DONE 1 STRING ?
BEQ 2$
CMPB (R1)+,(R2)+ ;MATCH ?
BEQ 1$ ;YES, KEEP TRYING
RETURN ;NO, RETURN FAILURE
2$: TSTB @R2 ;END OF ONE. END OF 2?
RETURN ;EQUAL OR NOT, HERE WE GO
10$: MOV R0,-(SP) ;SAVE WORK REG
11$: MOVB (R1)+,R0 ;GET FIRST BYTE
BMI 11$ ;IF SPACE OR TAB, SKIP IT
CMP (PC)+,R0 ;IS IT A SEMICOLON?
CMNTCH: 77777 ;A BYTE CAN NEVER EXTEND TO THIS
BNE 12$ ;NO (NEVER IF SWITCH OFF)
MOV #EFAKE+1,R1 ;YES, FAKE END OF LINE
12$: DEC R1 ;BACK UP TO GOODIE
13$: MOVB (R2)+,R0 ;GET ANUDDER BYTE
BMI 13$ ;SKIP BLANK OR TAB
BEQ 15$ ;END-OF-LINE
CMP CMNTCH,R0
BNE 14$ ;YES, ACT LIKE END OF LINE
MOV #EFAKE,R2
MOVB (R2)+,R0
14$: CMPB R0,(R1)+ ;MATCH ?
BEQ 11$ ;YES, KEEP TRYING
MOV (SP)+,R0 ;RESTORE REG
MOV (SP)+,PC ;NO MATCH. RETURN "NOT EQUAL"
15$: MOV (SP)+,R0 ;RESTORE R0
TSTB @R1 ;MATCH IF 1ST DONE, ELSE NO MATCH
RETURN
EFAKE: .BYTE CR,LF,0,0 ;ZERO
.DSABL LSB
.SBTTL MULTI LINE COMPARISON ROUTINE
; MULTI-LINE COMPARATOR
; CHECKS TO SEE WHETHER THE END OF A DIFFERENCE SECTION HAS BEEN FOUND
MULTIC: MOV C1,-(SP) ;SAVE STUFF
MOV C2,-(SP)
MOV COUNT,R3 ;NUMBER OF LINES THAT MUST MATCH
BEQ 2$ ;ONLY ONE!
1$: CALL GET2 ;GET 2 LINES
BNE 3$ ;EOF, SO FAIL
CALL COMPC ;DO THEY MATCH ?
BNE 3$ ;NO
DEC R3 ;YES. ARE WE DONE ?
BNE 1$ ;NO
2$: MOV (SP)+,R0 ;R0 = OLD C2
MOV (SP)+,R1 ;R1 = OLD C1
MOV #LOOP,@SP ;RETURN TO MAIN LOOP WHEN DONE
MOV C1,-(SP) ;END-OF-MATCH VALUE TO RESTORE
MOV C2,-(SP)
MOV R0,C2 ;RESTORE PRE-MATCH VALUES
MOV R1,C1
CALL PRBOTH ;PRINT THE DIFFERENCE
3$: MOV (SP)+,C2 ;FAILURE. RESTORE OLD POINTERS
MOV (SP)+,C1
RETURN
.SBTTL IMPURE AREA
.MACRO OFFSET N,SIZE
N = ..TEMP
.IF NB SIZE
..TEMP = SIZE + ..TEMP
.IFF
..TEMP = ..TEMP + 2
.ENDC
.ENDM OFFSET
..TEMP = 0
; PARAMETERS
LINLEN = 200. ;MAXIMUM LINE LENGTH
TABLEN = 200. ;NUMBER OF LINES THAT CAN FAIL
; OFFSETS
OFFSET C ;CURRENT LINE
OFFSET T ;TOP OF TABLE (HIGHEST READ)
OFFSET OTHER ;POINTER TO THE OTHER CHANNEL
OFFSET EOF ;EOF INDICATOR
OFFSET TBLPTR ;POINTER TO TABLE - 2
OFFSET PAGE ;PAGE NUMBER
OFFSET INPTR ;POINTER INTO INPUT BUFFER
OFFSET BUFFER ;POINTER TO BUFFER
OFFSET BUFEND ;POINTER TO TOP OF BUFFER
OFFSET BLKNO ;CURRENT BLOCK #
OFFSET CHANNO ;PHYSICAL CHANNEL TO USE
OFFSET IDENT ;POINTER TO IDENT STRING
OFFSET TABLE,2*TABLEN ;THE TABLE OF LINE POINTERS (MUST FOLLOW IDENT)
OFFSET TMAX ;POINTER TO TOP OF TABLE
.WORD CHAN2 ;LINK TO NEXT CHANNEL
CHAN1:
C1: .WORD 0
T1: .WORD 0
OTHER1: .WORD CHAN2
EOF1: .WORD 0
TBLPT1: .WORD TABL1-2
PAGE1: .WORD 1
INPTR1: .WORD 0
BUFR1: .WORD BUFER1
BUFE1: .WORD BUFER1+512.
BLKNO1: .WORD 0
CHANN1: EMT 200+3
IDENT1: .WORD ID1
TABL1: .BLKW TABLEN
TMAX1: .WORD .
BUFER1: .BLKW 256.
.WORD 0 ;LINK 0 => LAST CHANNEL
CHAN2:
C2: .WORD 0
T2: .WORD 0
OTHER2: .WORD CHAN1
EOF2: .WORD 0
TBLPT2: .WORD TABL2-2
PAGE2: .WORD 1
INPTR2: .WORD 0
BUFR2: .WORD BUFER2
BUFE2: .WORD BUFER2+512.
BLKNO2: .WORD 0
CHANN2: EMT 200+4
IDENT2: .WORD ID2
TABL2: .BLKW TABLEN
TMAX2: .WORD .
BUFER2: .BLKW 256.
; KEEP THESE WORDS IN ORDER!!!
LOFREE: .WORD 0
FRECOR: .WORD 0
COUNT: .WORD 0
SWITCH: .WORD 0 ;CONSOLE OUTPUT SWITCH
OBLK: .WORD 0
TOAD: .WORD 0 ;THE TOAD
OBUFE: .WORD 0
DIFMSG: .WORD 0
HIEND: .WORD 0
HIFREE: .WORD 0
ENDFLG: .WORD 0
.WORD 0,1,10.,100.
TENTBL:
.WORD OBUF2
.WORD OBUF2+512.
OBUF1: .BLKW 256.
.WORD OBUF1
.WORD OBUF1+512.
OBUF2: .BLKW 256.
DEFEXT: .RAD50 /MAC/
.WORD 0
.WORD 0,0
.NLIST BEX
NODIF: .ASCIZ "NO DIFFERENCES ENCOUNTERED"
YESDIF: .ASCIZ "%FILES ARE DIFFERENT"
HLPMSG: .ASCII "SRCCOM V01-03"
.ASCII "SRCCOM COMPARES TWO FILES IN ASCII MODE"
.ASCII "DEFAULT INPUT EXTENSION IS .MAC"
.ASCII "DEFAULT OUTPUT DEVICE IS TELETYPE"
.ASCII "SWITCHES ARE:"
.ASCII "/B ALLOW COMPARE OF BLANK LINES"
.ASCII "/C IGNORE COMMENTS AND SPACING"
.ASCII "/F SEND FORM FEEDS TO OUTPUT"
.ASCII "/S IGNORE SPACING"
.ASCII "/H TYPE THIS HELP TEXT"
.ASCII "/L:# NUMBER OF LINES TO BE MATCHED"
.ASCII " ( # REPRESENTS AN OCTAL NUMBER < 310)"
.BYTE 0
LSTARS: .ASCII "******"
STARS: .ASCII "****"
CRLF: .BYTE 015,012,0
.EVEN
ID1: .ASCII "1)"
.BYTE 0,0,0,0,0,0
ID2: .ASCII "2)"
.BYTE 0,0,0,0,0,0
SWTTBL: .ASCIZ "BCFSH" ;AVAILABLE SWITCHES
SWBLNK = 1 ;DO NOT COMPARE BLANK LINES
SWCMNT = 2 ;DO NOT COMPARE COMMENTS, BLANKS, TABS
SWFORM = 4 ;DO NOT PUT FORM FEEDS INTO OUTPUT
SWSPTB = 10 ;DO NOT COMPARE BLANKS, TABS
SWHELP = 20 ;HELP
; BLANKS, OR TABS
.EVEN
PGMTOP = .
.END START
.TITLE DUMP FILE UTILITY V02-02
; RT-11 DUMP UTILITY
;
; DEC-11-ORDMA-E
;
; ABC
;
; COPYRIGHT (C) 1974,1975
;
; DIGITAL EQUIPMENT CORPORATION
; MAYNARD, MASSACHUSETTS 01754
;
; THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY
; ON A SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH
; THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE,
; OR ANY OTHER COPIES THEREOF, MAY NOT BE PROVIDED OR OTHERWISE MADE
; AVAILABLE TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO
; ONE WHO AGREES TO THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE
; SOFTWARE SHALL AT ALL TIMES REMAIN IN DIGITAL.
;
; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO
; CHANGE WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED
; AS A COMMITMENT BY DIGITAL EQUIPMENT CORPORATION.
;
; DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE
; OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT
; WHICH IS NOT SUPPLIED BY DIGITAL.
;
.MCALL .SRESE, .CSIGE, .READW, .WRITE, .FETCH, .LOOKU, .PRINT
.MCALL .SETTO, .REGDEF,.WAIT, .CLOSE, .RCTRL, ..V1..
.REGDEF
..V1.. ;USE V1 MACRO EXPANSIONS
.MACRO PUT ARG
JSR R3,@R2
.WORD ARG
.ENDM
.MACRO OCT ARG
JSR R3,OCTOUT
.WORD ARG
.ENDM
SPINIT=42
JSW=44
ERRLOC=52
RMON=54
USRBUF=266
CSWEOF=20000
.SBTTL ROUTINE INITIALIZATION
BR CONT ;REENTRY ADDRESS
START: MOV @#RMON,R0 ;POINT TO RMON
MOV USRBUF(R0),R0 ;LAEVE USR RESIDENT
TST -(R0) ;FIX FOR SETTOP
.SETTOP
TST (R0)+ ;REFIX
MOV R0,TOP ;SAVE POINTER TO TOP
BIS #20000,@#JSW ;REENTERABLE
.SBTTL RESTART
CONT: MOV @#SPINIT,SP ;INIT STACK
.SRESET
.RCTRLO ;SPEAK, OH MIGHTY TTY
.CSIGEN #PGMTOP,#DEFEXT,#0 ;GET INPUT FILE
MOV R0,R2 ;COPY CORE PTR FOR MACRO
.WAIT 1 ;DID HE SPECIFY MORE THAN 1 OUTPUT FILE?
BCC ERR5 ;YES
.WAIT 2
BCC ERR5
.WAIT 4 ;DID HE SPECIFY MORE THAN 1 INPUT FILE?
BCC ERR5 ;YES
.WAIT 3 ;DID HE GIVE AN INPUT FILE ?
BCS CONT ;NO, JUST A RANDOM CR.
.WAIT 0 ;DID HE GIVE OUTPUT FILE?
BCC 1$ ;YES, USE IT
.FETCH R2,#LP
BCS ERR0 ;NOT THERE
MOV R0,R2 ;SAVE CORE PTR
.LOOKUP 0,#LP ;OPEN LP
BCS ERR0
1$: MOV #TOP,R3 ;POINT TO DATA STUFF
MOV (R3)+,R1 ;GET TOP OF CORE
MOV R2,(R3)+ ;SAVE START OF FREE
SUB R2,R1 ;COMPUTE SIZE OF BUFFER
CMP R1,#1000 ;MAKE SURE WE HAVE AT LEAST 256. WORDS
BLOS ERR4 ;NO CORE
MOV #1,(R3)+ ;SAVE BUFFER SIZE OF ONE BLOCK
MOV #/2,R0 ;COUNT TO CLEAR
2$: CLR (R3)+
DEC R0
BNE 2$
MOV #-2,EBLOCK ;VERY HIGH END BLOCK
.SBTTL SWITCH INTERPRETER
MOV (SP)+,R5 ;GET SWITCH COUNT
SWITCH: DEC R5 ;ANY MORE?
BMI BEGIN ;NO, DO THE DUMP
MOV #SBLOCK,R3 ;POINT TO POINTERS
MOV #SWTBL,R2 ;SWITCH TABLE
CMPB @SP,#'O ;'ONLY' IS SPECIAL CASE
BNE 1$
MOV 2(SP),@R3 ;WHICH SETS BEGIN BLOCK
MOVB #'E,@SP ;AND END BLOCK
1$: CMPB -(R2),@SP ;IS THIS THE ONE ?
BEQ 3$ ;GOT IT
TST (R3)+ ;BUMP DESTINATION
TSTB -(R2) ;END OF TABLE ?
BNE 1$ ;NO, GO ON
2$: .PRINT #MSG1 ;SWITCH ERROR
BR CONT
3$: TST (SP)+ ;VALUE GIVEN ?
BMI 4$ ;YES, HANDLE IT THERE
MOVB -(R2),R0 ;GET FIXED VALUE
BMI 2$ ;HE SHOULD HAVE GIVEN ONE
MOV R0,@R3 ;PUT IN VALUE
BR SWITCH
4$: TSTB -(R2) ;WAS VALUE LEGAL ?
BPL 2$ ;NO
MOV (SP)+,@R3 ;YES, PUT IT IN
BR SWITCH
.SBTTL END PROCESSING, ERRORS
EOFCHK: TSTB @#ERRLOC ;WHAT KIND?
BNE ERR3 ;INPUT ERROR
FILL: MOV BUFCTR,R3 ;GET NUMBER OF CHARS LEFT
CMP R3,#-512. ;EMPTY?
BEQ 2$ ;YES, CLOSE OUTPUT FILE
1$: CLRB (R4)+
INC R3
BNE 1$
JSR PC,EMIT1 ;WRITE BUFFER LOAD
2$: .WAIT 0
.CLOSE 0 ;CLOSE OUTPUT
BR CONT
ERR0: .PRINT #MSG0
BR CONT
ERR3: TST IGNORE ;DO WE IGNORE INPUT ERRORS ?
BNE READIG ;YEP
.PRINT #MSG3 ;IN ERR
BR CONT
ERR4: .PRINT #MSG4 ;NO CORE
BR CONT
ERR5: .PRINT #MSG5 ;ILLEGAL COMMAND
BR CONT
.SBTTL FILE INITIALIZATION, READ
BEGIN: MOV #LBUFF1,R4 ;START WITH BUFFER 1
MOV #-512.,BUFCTR ;COUNT OF SIZE
MOV #SBLOCK,R3 ;POINT TO POINTERS
SUB (R3)+,@R3 ;COMPUTE # OF BLOCKS
BLO CONT ;ALREADY FINISHED
INC @R3 ;MAKE IT REAL COUNT
MOV #FORCE,R2 ;WE CALL THIS A LOT
MOV #HDRMSG+1,HDRPTR ;DO NOT START W/ FORM FEED
READ: MOV #BUFFER,R3 ;POINT TO DATA BUFFER PTR
MOV (R3)+,R5 ;R5 -> DATA BUFFER
MOV (R3)+,R1 ;R1 = # BLOCKS IN BUFFER
MOV (R3)+,R0 ;R0 = BLOCK # TO START
CMP R1,@R3 ;BUFSIZ <= XFER LEFT?
BLOS 1$ ;YES, READ ENTIRE BUFFER LOAD
MOV @R3,R1 ;NO, READ ONLY WHAT'S LEFT
BEQ FILL ;DONE!
1$: SUB R1,@R3 ;DECREMENT BLOCKS LEFT
SWAB R1 ;MAKE READ A WORD COUNT
.READW 3,R5,R1 ;READ CHUNK
BCS EOFCHK ;BAD OR EOF
MOV @#54,-(SP) ;ADDR OF SYSPTR ON STACK
ADD #42,(SP) ;ADDRESS OF CSW FOR CHANNEL 3 ON STACK
MOV @(SP),(SP) ;GET CSW FOR CHANNEL 3 ON STACK
BIT #CSWEOF,(SP)+ ;EOF BIT ON?
BEQ READIG ;NO
BR FILL ;YES-SIMULATE EOF (NEEDED FOR MT AND CT)
READIG: MOV R0,WDCTR ;PRESERVE WORDS ACTUALLY READ
.SBTTL PROCESS 8 WORDS
LINE: MOV R5,R0 ;PREPARE TO PRINT LINE ADDRESS
SUB BUFFER,R0 ;COMPUTE OFFSET IN BUFFER
BIC #177000,R0 ;MAKE IT OFFSET IN BLOCK
BEQ HEADER ;IF ZERO, PAGE EJECT AND TITLE
LINE0: OCT 3 ;3 DIGIT ADDRESS
PUT SLASH ;DELIMITER
MOV #16.,R3 ;EIGHT WORDS / LINE
TST BYMODE ;BYTE OUTPUT MODE ?
BEQ WORDPR ;NO, DO WORD PROCESSING
TST WMODE ;YES, HE MUST ASK FOR WORDS
BEQ BYLOOP ;HE DIDN'T. GO PUT BYTES
; PRINT A LINE OF WORDS
WORDPR: ASR R3 ;EIGHT WORDS, NOT 16
WORD: PUT BLANK ;SPACE THE WORD
MOV (R5)+,R0 ;GET WORD TO OUTPUT
OCT 6 ; AS 6 DIGITS
TST BYMODE ;EXTRA SPACING NEEDED ?
BEQ 1$ ;GO IF NO
PUT BLANK ;YES
1$: DEC R3 ;ANY MORE HERE?
BNE WORD ;YES
MOV #16.,R3 ;COUNT OF 16 BYTES OR CHARS
SUB R3,R5 ;BACK UP FOR SOMETHING
TST BYMODE ;BYTES GOING OUT ?
BNE BYTEPR ;YES. PRINT BYTES
TST NMODE ;DOES HE WANT BYTES ?
BNE PUTCR ;NO. END THE LINE
PUT BLAST ;BLANK ASTERISK
CHAR: JSR PC,PUTCH ;PUT A CHARACTER
BNE CHAR ;LOOP UNTIL DONE
PUT STARCL ;* CR LF
BR X50CK ;NO BYTES. GO CHECK RAD 50
BYTEPR: PUT CRLF ;END THE WORD LINE
PUT BL4 ;SPACE OUT THE BYTES
BYLOOP: PUT BLANK ;SEPARATION
MOVB (R5)+,R0 ;BYTE TO PRINT
BIC #177400,R0 ;PLEASE
OCT 3 ;ONLY A BYTE
DEC R3 ;ANY MORE ?
BNE BYLOOP ;YES
PUT CRLF ;NO, END OF LINE
TST NMODE ;SUPPRESS ASCII ?
BNE X50CK ;YES
MOV #16.,R3 ;NO, 16 CHARS
SUB R3,R5 ;BACK UP
PUT BL2 ;PRE SPACE
ASLOOP: PUT BL3 ;SPACER
JSR PC,PUTCH ;CHARACTER PUTTER
BNE ASLOOP ;NOT DONE
PUTCR: ADD R3,R5 ;ADVANCE OR NOT
PUT CRLF ;DONE. END LINE
X50CK: TST XMODE ;ANY RADIX 50?
BEQ NEXTLN
MOV #8.,R3 ;WORD COUNT
SUB #16.,R5 ;DECREMENT BY 16
TST BYMODE
BNE X50OUT
PUT BLANK ;INITIAL SPACE
X50OUT: MOV #BL4,R1 ;PRINT 4 BLANKS
SUB BYMODE,R1 ; (SOMETIMES 5)
JSR R3,FORCE1 ; TO OUTPUT FILE
MOV (R5)+,R0 ;GET A WORD
JSR PC,R50UNP
DEC R3
BNE X50OUT
PUT CRLF
NEXTLN: SUB #8.,(PC)+ ;DONE 8 WORDS. ANY MORE?
WDCTR: .WORD 0
BHI LINE ;YES
JMP READ ;NO, READ SOME MORE
.SBTTL PRINT HEADER
HEADER: JSR R3,@R2 ;PUT HEADER
HDRPTR: .WORD 0
MOV SBLOCK,R0 ;PRINT BLOCK NUMBER
INC SBLOCK ;BUMP FOR LATER
OCT 5 ;PRINT 4 DIGIT FIELD
PUT CRLF ;EMIT CR LF
CLR R0 ;ZERO WORD NUMBER
MOV #HDRMSG,HDRPTR ;FORM FEEDS FROM NOW ON
BR LINE0
.SBTTL OCTAL NUMBER OUTPUT
OCTOUT: MOV (R3)+,R1 ;GET FIELD SIZE
CLR -(SP) ;SET MARKER
1$: MOV R0,-(SP) ;GET BYTE
BIC #177770,@SP
BIS #'0,@SP
CLC
ROR R0
ASR R0
ASR R0
DEC R1
BNE 1$
2$: MOV (SP)+,R0
BEQ RTS3
JSR PC,EMIT ;PUT DIGIT
BR 2$
.SBTTL RAD 50 UNPACK ROUTINE
R50UNP: MOV #COEFF,R1
MOV R0,-(SP) ;SAVE WORD TO UNPACK
1$: CLR R0 ;MAKE A PLACE
2$: CMP @SP,@R1 ;DONE YET?
BLO 3$ ;YES
SUB @R1,@SP
INC R0
BR 2$
3$: TSTB R0 ;FIND RAD50 RANGE
BEQ 4$
CMPB R0,#33 ;$ ?
BEQ 6$
BGT 5$ ;DIGIT
ADD #40,R0 ;ALPHA
4$: ADD #16,R0
5$: ADD #11,R0
6$: ADD #11,R0
JSR PC,EMIT ;PUT CHARACTER
TST -(R1)
BNE 1$
TST (SP)+ ;PRUNE
RTS PC
.WORD 0,1,40.
COEFF: .WORD 1600.
ERR2: .PRINT #MSG2 ;OUT ERR
JMP CONT
.SBTTL OUTPUT ROUTINES
PUTCH: MOVB (R5)+,R0 ;GET CHARACTER
BIC #177600,R0 ;TRIM
CMP #177,R0 ;DON'T PRINT RUBOUT
BEQ 2$
CMP R0,#40 ;PRINTABLE?
BGE 1$ ;YES
2$: MOV #'.,R0 ;NO, PUT A .
1$: JSR PC,EMIT ;OUTPUT A BYTE
DEC R3
RTS PC
EMIT: MOVB R0,(R4)+ ;PUT CHAR IN BUFFER
INC (PC)+ ;BUMP COUNTER
BUFCTR: .WORD 0
BNE EMITR ;NOT FULL YET
EMIT1: SUB #512.,R4 ;POINT TO BEGINNING
.WAIT 0 ;WAIT FOR FORMER TO END
BCS ERR2 ;ERROR
.WRITE 0,R4,#256.,LBLOCK
BCS ERR2
INC LBLOCK
MOV #-512.,BUFCTR
MOV -(R4),R4 ;POINT TO OTHER BUFFER
EMITR: RTS PC
FORCE: MOV (R3)+,R1 ;POINT TO STRING
FORCE1: MOVB (R1)+,R0 ;PUT CHAR
BEQ RTS3 ;OUT ON 0
JSR PC,EMIT
BR FORCE1
RTS3: RTS R3
.SBTTL DATA AREA
TOP: .WORD 0
BUFFER: .WORD 0
SIZE: .WORD 0
CLEARS: ;START OF CLEAR AREA
SBLOCK: .WORD 0
EBLOCK: .WORD 0
BYMODE: .WORD 0
XMODE: .WORD 0
WMODE: .WORD 0
NMODE: .WORD 0
IGNORE: .WORD 0
LBLOCK: .WORD 0
CLEARE: ;END OF CLEAR AREA
.NLIST BEX
.WORD 0 ;END OF LIST
.BYTE 1,'G ;IGNORE INPUT ERRORS
.BYTE 1,'N ;NO ASCII IF BYTES
.BYTE 1,'W ;WORDS IF BYTES
.BYTE 1,'X ;RAD 50
.BYTE 1,'B ;BYTES
.BYTE -1,'E ;END BLOCK #
.BYTE -1,'S ;START BLOCK #
SWTBL:
MSG0: .ASCIZ /?LP NOT FND?/
MSG1: .ASCIZ /?SWITCH?/
MSG2: .ASCIZ /?OUT ERR?/
MSG3: .ASCIZ /?IN ERR?/
MSG4: .ASCIZ /?NO CORE?/
MSG5: .ASCIZ /?ILL CMD?/
.EVEN
DEFEXT: .WORD 0
.RAD50 "DMP"
.WORD 0,0
LP: .RAD50 /LP /
.WORD LBUFF2
LBUFF1: .BLKW 256.
.WORD LBUFF1
LBUFF2: .BLKW 256.
HDRMSG: .BYTE 14
.ASCIZ "BLOCK NUMBER "
STARCL: .BYTE '*
CRLF: .BYTE 015,012,0
SLASH: .ASCIZ "/"
BLAST: .ASCIZ " *"
BL5: .ASCII " "
BL4: .ASCII " "
BL3: .ASCII " "
BL2: .ASCII " "
BLANK: .ASCIZ " "
VNUM: .ASCIZ "V02-02"
.EVEN
PGMTOP=.
.END START
.TITLE ODT V01-02 9/18/75 ;IF YOU CHANGE THE VERSION #,
;DON'T FORGET TO CHANGE AT O.ID!
; RT-11 ODT (ADAPTATION OF ODT-11R)
; DEC-11-ORODA-E
; DECEMBER 7,1972
; R. BEAN,JD
;
; COPYRIGHT (C) 1974,1975
;
; DIGITAL EQUIPMENT CORPORATION
; MAYNARD, MASSACHUSETTS 01754
;
; THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY
; ON A SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH
; THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE,
; OR ANY OTHER COPIES THEREOF, MAY NOT BE PROVIDED OR OTHERWISE MADE
; AVAILABLE TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO
; ONE WHO AGREES TO THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE
; SOFTWARE SHALL AT ALL TIMES REMAIN IN DIGITAL.
;
; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO
; CHANGE WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED
; AS A COMMITMENT BY DIGITAL EQUIPMENT CORPORATION.
;
; DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE
; OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT
; WHICH IS NOT SUPPLIED BY DIGITAL.
;
;EDIT # V01-02-00
.GLOBL O.ODT ;GETS ENTRY POINT TO SHOW UP IN LOAD MAP
;
. = .+144+26 ;RESERVES SPACE FOR STACK
R0 = %0 ; REGISTER
R1 = %1 ; NAMING
R2 = %2 ; CONVENTIONS
R3 = %3
R4 = %4
R5 = %5
SP = %6
PC = %7
ST = 177776 ;STATUS REGISTER
O.BKP = 16 ;NUMBER OF BREAKPOINTS-1 MULT. BY 2
O.RLR = 16 ;NO. OF RELOC. REGISTERS-1, TIMES 2
O.TVEC = 14 ;TRT VECTOR LOCATION
O.RELC = 20 ;NUMBER OF RELOC.REGISTERS(TIMES 2)
O.STM = 340 ;PRIORITY MASK - STATUS REGISTER
O.TBT = 20 ;T-BIT MASK - STATUS REGISTER
TRT = 000003 ;TRT INSTRUCTION
O.RDB = 177562 ;R DATA BUFFER
O.RCSR = 177560 ;R C/SR
O.TDB = 177566 ;T DATA BUFFER
O.TCSR = 177564 ;T C/SR
MTPS = 106400 ;MOVE TO PS FOR LSI
MFPS = 106700 ;MOVE FROM PS FOR LSI
; INITIALIZE ODT
; USE O.ODT FOR A NORMAL ENTRY
; USE O.ODT+2 TO RESTART ODT - WIPING OUT ALL BREAKPOINTS
; USE O.ODT+4 TO RE-ENTER (I.E. - FAKE A BREAKPOINT)
O.ODT: BR O.STRT ;NORMAL ENTRY
BR O.RST ;RESTART
O.ENTR: JSR PC,O.RRST ;RE-ENTER -- SAVE STATUS
MOV O.TVEC+2,-(SP) ;SET UP LOCAL STATUS
JSR PC,O.WST
MOV PC,-(SP) ;FAKE THE PC
MOV (SP)+,O.UPC
MOVB #-1,O.P ;DISALLOW PROCEED
CLRB O.S
JMP O.BK1
O.STRT: NOP ;TO SAVE STATUS
NOP ;JSR PC,O.RRST FOR PDP11
;MFPS,O.UST FOR LSI
MOV @#4,-(SP) ;SAVE RT INTERRUPT VECTOR
MOV #O.STR1,@#4 ;SET ODT VECTOR
TST ST ;LSI WILL TRAP TO 4
;PDP11 WILL CONTINUE
BR O.STR2 ;DON'T CHANGE ACCESS TO PS
O.STR1: MOV #MFPS+67,O.RRST ;CHANGE PS ACCESS IN TWO SUBROUTINES
;O.RRST AND O.WST
;STORE MFPS O.UST IN O.RRST
MOV #O.UST-O.RRST-4,O.RRST+2
MOV #NOP,O.RRST+4
MOV #MTPS+66,O.WST ;STORE MTPS 2(SP)
MOV #240,O.WST+4
MOV #O.STR2,(SP) ;REPLACE PC ON STACK WITH CONTINUE
;LOCATION.PC,SP WERE PUT THERE BY
;THE TIMEOUT TRAP TO 4
RTI ;RESTORE PS AND CONTINUE AT O.STR2
O.STR2: MOV (SP)+,@#4 ;RESTORE CONTENTS OF 4
;RUN AT CURRENT STATUS
JSR 5,O.SVTT ;SAVE TTY STATUS
JSR 0,O.SVR ;SAVE REGISTERS (MAINLY SP)
MOV #O.UR0,SP ;SET UP STACK
MOV #O.ID,R4 ;TYPE ID
MOV #O.IDND,R3
JSR 5,O.TYPE
BR O.RST1
O.RST: JSR 0,O.SVR ;SAVE REGISTERS
JSR 5,O.REM ;REMOVE ALL BREAKPOINTS
JSR 5,O.CLRR ; CLEAR RELOCATION REGISTERS
MOVB O.PRI,R4 ;GET ODT PRIORITY
RORB R4 ;SHIFT
RORB R4 ; INTO
RORB R4 ; POSITION
MOVB R4,-(SP) ;STORE IN STATUS
JSR PC,O.WST
O.RST1: CLRB O.S ;DISABLE SINGLE INSTRUCTION FOR NOW
MOVB #-1,O.P ;DISALLOW PROCEED
MOV #O.STM,O.TVEC+2 ;STATUS WORD TO TRT VECTOR+2
MOV #O.BRK,O.TVEC ;PC TO TRT VECTOR
; THIS NEXT INSTRUCTION RAISES THE "Z" FLAG BECAUSE
; ITS PURPOSE IN LIFE IS TO BEHAVE DIFFERENTLY ON THE /20
; AND THE /45 SO WE CAN CHANGE THE RTT WHICH ALSO
; BEHAVES DIFFERENTLY ON THE /20 AND /45.
JMP (PC)+ ;PROCESSOR DEPENDENT INSTRUCTION
BR O.45 ;THIS PROCESSOR IS A 40 OR 45
MOV #RTI,O.RTIT ;CHANGE THE RTT TO AN RTI IF THEIS IS 11/20 OR 05
O.45: JMP O.RALL ;CLEAR BRK PT TABLES
;
;O.CTLC
; ^C PROCESSING. RETURN TO KEYBOARD MONITOR
;
;
O.CTLC: MOV O.USP,SP ;RESTORE USER STACK
MOV #O.CCST,R4
MOV #O.CCSP,R3
JSR R5,O.TYPE ;ECHO "^C"
MOVB #100,O.RCSR ;TURN ON KEYBOARD INTERRUPT
MOV SP,R0 ;WE WANT EXIT TO DO A SOFT RESET
EMT 340+10 ;EXIT TO KEYBOARD MONITOR
O.CCST: .BYTE '^
O.CCSP: .BYTE 'C
; O.ALF REXP;NA TYPE N CHARACTERS STARTING AT REXP;
; THEN--
; ACCEPT A STRING OF ASCII TEXT. STORE IT IN
; SUCCESIVE BYTES STARTING AT THE INDICATED
; LOCATION. TEXT TERMINATED BY COUNT, N.
; OR CR OR LF. ODT PRINTS THE ADDR OF
; THE NEXT AVAILABLE LOCATION IN CORE
;
O.ALF: TST R3 ;WAS REXP TYPED?
BEQ O.ELF1 ;BR IF NOT
TSTB O.SMFD ;WAS ; TYPED?
BEQ O.ELF1 ;BR IF NOT, ERROR
TST R2 ;IF N NOT TYPED, ASSUME 1
BNE O.ELF4
INC R4
O.ELF4: MOV R4,-(SP) ;SAVE COUNT
;SET UP TO TYPE N CHAR.
MOV R5,R4 ;ADDR OF 1ST BYTE IN R4
MOV R5,R3 ;ADDR OF 1ST BYTE IN R3
ADD (SP),R3 ;ADD N TO R3
DEC R3 ;SUB. 1 TO GET LAST ADDR
MOV R3,O.XXX ;SAVE LAST ADDR.
JSR 5,O.TYPE ;TYPE THE CHARACTERS
JSR 5,O.CRLF ;TYPE CR/LF
MOV (SP)+,R4 ;RECALL N TO R4
;NOW ACCEPT INPUT STRING
INCB O.SCRN ;ALLOW SPACES VIA O.GET
JSR 5,O.GET ;LOOK AT FIRST CH.
CMPB R0,#015 ;IS IT A CARR.RET?
BEQ O.ELF5 ;IF YES, RETURN TO COMM. DEC.
CMPB R0,#012 ;CHK FOR LF
BNE O.ELF7 ;IF NOT, ACCEPT N CHARACTERS
CLRB O.SCRN ;MAKE SPACES INVISIABLE TO O.GET
MOV O.XXX,R4 ;IF LINE FEED, OPEN NEXT AVAILABLE CH.
INC R4
INC R2
MOV R4,R0 ;PRINT NEXT AVAIL BYTE
MOV R2,-(SP) ;SAVE TO AVOID CLOBBERRING
MOV R4,-(SP) ;BY O.RORA
JSR 5,O.RORA
MOV (SP)+,R4
MOV (SP)+,R2
MOVB #'\,R0 ;PRINT BACK SLASH
JSR 5,O.FTYP
JMP O.BYT
O.ELF3: JSR 5,O.GET ;GET NXT CH.
O.ELF7: JSR 5,O.CU ;CHK FOR ^U
MOVB R0,(R5)+
DEC R4 ;REDUCE COUNT. IS IT ZERO?
BEQ O.ELF2 ;BR IF YES
BR O.ELF3
O.ELF2: MOV R5,-(SP) ;PRINT NXT AVAIL LOC:
JSR 5,O.CRLF ;CR,LF
MOVB #2,O.BW ;FORCE WORD MODE
MOV (SP)+,R0 ;THEN, ADDRESS
JSR 5,O.RORA ;
O.ELF5: CLRB O.SCRN ;MAKE SPACE INVISABLE TO O.GET
JMP O.DCD ;RETURN TO COMMAND DECODER
O.ELF1: JMP O.ERR
;
; SPECIAL NAME HANDLER
; DEPENDS UPON THE EXPLICIT ORDER OF THE TWO TABLES O.TL AND O.UR0
O.REGT: JSR 5,O.GET ;SPECIAL NAME, GET ONE MORE CHARACTER
MOV #O.TL,R4 ;TABLE START ADDRESS
O.RSP: CMPB R0,(R4)+ ;IS THIS THE CORRECT CHARACTER?
BEQ O.SP ;JUMP IF YES
CMP #O.TL+O.LG,R4 ;IS THE SEARCH DONE?
BHI O.RSP ;BRANCH IF NOT
BIC #177770,R0 ;MASK OFF OCTAL
MOV R0,R4
O.SP1: ASL R4
ADD #O.UR0,R4 ;GENERATE ADDRESS
INC R2 ;SET FOUND FLAG
JMP O.SCAN ;GO FIND NEXT CHARACTER
O.SP: SUB #O.TL-7,R4 ;GO FIND NEXT CHARACTER
BR O.SP1
;RETYPE OPENED WORD IN ANSCII (CONVERTED FROM MOD40)
O.MOD: MOV O.CAD,R0 ;CALL MOD40 UNPACK
MOV #O.ALF1,R1
JSR PC,UNPA00 ;ASCII CHARS GO INTO O.ALF1,2,3
MOV #'=,R0 ;PRINT "="
JSR R5,O.FTYP
INCB O.SCRN ;SET FLAG TO ALLOW SPACES
MOVB O.ALF1,R0 ;PRINT 1ST CHAR
JSR R5,O.FTYP
MOVB O.ALF2,R0 ;PRINT 2ND CH
JSR R5,O.FTYP
MOVB O.ALF3,R0 ;PRINT 3RD CH
JSR R5,O.FTYP
MOV #' ,R0 ;PRINT SPACE
JSR R5,O.FTYP
JSR R5,O.GET ;USER MUST NOW TYPE:
CMPB R0,#' ;IF CHAR IS LESS THAN SPACE,
BLT O.MOD1 ;PREPARE TO ENTER COMMAND DECODER
MOVB R0,O.ALF1 ;OTHERWISE READ 3 CHAR
JSR R5,O.GET ;2ND CH
MOVB R0,O.ALF2
JSR R5,O.GET ;3RD CHAR
CLRB O.SCRN ;RESTORE O.GET TO NORMAL
MOVB R0,O.ALF3
MOV #O.XXX,R0 ;TELL MOD40 TPACK TO PACK
MOV #O.ALF1,R1 ;INTO O.XXX
JSR PC,PACK00
MOV O.XXX,R4 ;MAKE IT APPEAR AS IF THE
MOV #1,R2 ;PACKED # WAS TYPED
JMP O.SCAN ;LET COMMAND DECODER DO THE REST
O.MOD1: CLRB O.SCRN
CLR R4 ;MAKE IT APPEAR
CLR R2 ;AS IF NO NUMBERS WERE TYPED IN
O.MOD2: JMP O.SCN1 ;TYPED IN
; "BACKARROW" HANDLER - OPEN INDEXED ON THE PC (BACK ARROW)
O.ORPC: JSR 5,O.TCLS ;TEST WORD MODE AND CLOSE
ADD @R2,R2 ;COMPUTE
INC R2
INC R2 ; NEW ADDRESS
O.PCS: MOV R2,O.CAD ;UPDATE CAD
JMP O.OP2A ;GO FINISH UP
O.ORAB: JSR 5,O.TCLS ;TEST WORD MODE AND CLOSE
MOV @R2,R2 ;GET ABSOLUTE ADDRESS
BR O.PCS
O.ORRB: JSR 5,O.TCLS ;TEST AND CLOSE
MOV @R2,R1 ;COMPUTE NEW ADDRESS
MOVB R1,R1 ;EXTEND THE SIGN
ASL R1 ;R2=2(@R2)
INC R1 ; +2
INC R1
ADD R1,R2 ; +PC
BR O.PCS
O.TCLS: JSR PC,O.CLSE ;CLOSE CURRENT CELL
CMP #2,O.BW ;ONLY WORD MODE ALLOWED
BNE O.TCL1 ;BRANCH IF ERROR
MOV O.CAD,R2 ;CURRENT ADDRESS IN R2
RTS R5
O.TCL1: TST (SP)+
O.TCL2: JMP O.ERR ;POP A WORD AND SHOW THE ERROR
; PROCESS S - SINGLE INSTRUCTION MODE
O.SNGL: TSTB O.SMFD ;DONT REACT IF ; NOT TYPED
BEQ O.TCL2
TST R2 ;SEE IF TURN ON OR TURN OFF
BNE O.SI1 ;BRANCH IF TURNING IT ON
CLRB O.S ;CLEAR THE FLAG
JMP O.DCD ;CONTINUE THE SCAN
O.SI1: MOVB #-1,O.S ;SET THE FLAG
O.SI2: JMP O.DCD
;COMMA PROCESSING. N IN R4 IS THE RELOCATION REGISTER NUMBER
;
O.COMM: INCB O.CMFD ;SET "COMMA FOUND" SWITCH TO ON
TST R2 ;WAS A NUMBER TYPED IN?
BEQ O.COM1 ;NO,USE CURRENT BIAS; I.E.,EXIT
BIC #177770,R4 ;MAKE SURE THAT N IS LESS THAN 10(8)
ASL R4 ;YES, LOCATE RELOC. REGISTER
MOV O.RELT(R4),O.BIAS ;PUT BIAS IN O.BIAS
O.COM1: BR O.MIN1 ;GO BACK TO DECODER
;R PROCESSING. SEVERAL POSSIBILITIES-
; A. ;R WAS TYPED. ZERO OUT ALL RELOCATION REGISTERS
; B. ;NR WAS TYPED. ZERO OUT $NR
; C. REXP;NR WAS TYPED. SET $NR TO REXP
; D. NR WAS TYPED, WHILE A WORD WAS OPENED-
; COMPUTE (O.CAD)-($NR) AND PRINT IT
;
O.REL: TSTB O.SMFD ;TEST IF A SEMICOLON WAS TYPED
BEQ O.REL1 ;NO CASE D
TST R2 ;NOTHING OPENED, WAS N TYPED?
BEQ O.REL2 ;N NOT TYPED
O.REL4: BIC #177770,R4 ;GUARANTEE THAT N<10
ASL R4 ;N TYPED, CASE B OR C. SET $NR.
TST R3 ;IF REXP NOT TYPED,CLEAR TO -1
BEQ O.RELA
MOV R5,O.RELT(R4) ;IF REXP NOT TYPED, R5=0. CASE B.
O.REL5: BR O.H1 ;EXIT TO DECODER
O.REL2: TST R3 ;IF REXP TYPED, CASE B OR C WITH N=0
BEQ O.REL3 ;REXP NOT TYPED, N NOT TYPED, CLEAR ALL.
BR O.REL4 ;REXP TYPED- N NOT TYPED
O.RELA: MOV #-1,O.RELT(R4)
BR O.H1
;CLEAR RELOCATION REGISTERS.
O.REL3: JSR 5,O.CLRR ;CLEAR RELOC REG'S
BR O.SI2 ;GO BACK TO SCAN
O.REL1: CMP O.BW,#2 ;CASE D, PRINT @O.CAD IN RELATIVE FORM
BNE O.TCL2 ;ERROR IF BYTE OPENED
CMP #0,R2 ; CHECK IF R
BNE O.REL6 ; IF R
MOV @O.CAD,R0
JSR R5,O.LOC ; THEN FIND BEST N
CMP R0,#-1 ;WAS A RELOC REG FOUND?
BNE O.REL8 ;BR IF YES. ELSE--
MOV #'=,R0 ;TYPE "="
JSR 5,O.FTYP
MOV @O.CAD,R0 ;TYPE ABS. VAL OF CONTENTS
BR O.REL9 ;OF OPENED LOC.
O.REL8: MOV R0,R4 ; PUT NEW N INTO R4
O.REL6: MOV @O.CAD,R1 ;OPENED VALUE IS THE MINUEND
MOV R4,O.TMP1 ; SAVE N
ASL R4 ;GET BIAS FROM $NR
SUB O.RELT(R4),R1 ;BIAS IS THE SUBTRAHEND
MOV #'=,R0 ;TYPE "="
JSR 5,O.FTYP
MOV O.TMP1,R0 ; PREPARE INPUTE FOR O.FTYP
ADD #60,R0 ; CONVERT N TO ANSCII
JSR 5,O.FTYP ; TYPE N
MOV #',,R0 ;PREPARE INPUT FOR O.FTYP
JSR 5,O.FTYP ; TYPE COMMA
CMP #0,R2 ; CHECK IF R
BNE O.REL7 ; IF R
MOV O.XXY,R0 ; THEN PREPARE INPUT FOR O.CADV
O.REL7: MOV R1,R0 ;TYPE THE VALUE (@O.CAD)-($NR)
O.REL9: JSR 5,O.CADV
BR O.DCD1
;
;C PROCESSING.
; A. REXP;C WAS TYPED- PRINT THE VALUE OF REXP AND STORE IN $C
; B. ;C WAS TYPED- SAME AS C., BUT REXP=0 BY DEFAULT
; C. NO SEMICOLON HAS BEEN TYPED-REPLACE R4 WITH THE CONTENTS OF $C
O.CNS: TSTB O.SMFD ;WAS A SEMICOLON TYPED?
BNE O.CNS1 ;REXP TYPED PRIOR TO ; CASE A
MOV O.CNST,R4 ;CASE C. REPLACE R4 WITH ($C)
MOV #1,R2
BR O.SCAN ;RETURN TO SCAN MORE
O.CNS1: MOV #'=,R0 ;PRINT VALUE
MOV #2,O.BW
JSR 5,O.FTYP
MOV R5,R0
JSR 5,O.CADV
MOV R5,O.CNST ;AND STORE IN $C
O.H1:
O.CNS2: BR O.DCD
;
;MINUS PROCESSING
;
O.MIN: INCB O.MINS ;SET MINUS FOUND SWITCH ON
O.MIN1: BR O.DCD1
.EOT ;END OF TAPE #1
;
;REPRINT LAST OPENED ADDRESS RELATIVELY.
; A. N! WAS TYPED--PRINT N,((O.CAD)-($NR))
; B. ! WAS TYPED. FIND THE CLOSEST BIAS LESS THAN
; (O.CAD) AND USE ITS "N" -- THEN DO CASE A.
;
O.RCMP: MOV #'=,R0 ;FIRST TYPE A "="
JSR 5,O.FTYP ;WAS N TYPED IN?
TST R2 ;WAS N TYPED IN?
BNE O.RCM1 ;BRANCH IF YES
MOV O.CAD,R0
JSR 5,O.LOC ;ELSE, FIND BEST N
CMP R0,#-1 ;IF REL.REG FOUND,
BNE O.RCM2 ; BR; ELSE--
MOV O.CAD,R0 ;PRINT ADDR IN ABS.
JSR 5,O.CADV
BR O.DCD1
O.RCM2: ADD #060,R0 ;CONVERT N TO ANSCII
JSR 5,O.FTYP ;TYPE N
MOV #',,R0 ;TYPE COMMA
JSR 5,O.FTYP
MOV O.BW,-(SP) ;SAVE O.BW
MOV #2,O.BW ;ARTIFCIALLY SET MODE FOR WORDS
MOV O.XXY,R0 ;TYPE RELATIVE AMOUNT
O.RCM3: JSR 5,O.CADV
MOV (SP)+,O.BW ;RESTORE MODE
BR O.DCD1 ;EXIT TO SCAN ROUTINE
O.RCM1: MOV R4,R0 ;GET N. THIS CODE SIMULATES O.LOC
ASL R0 ;TIMES 2 FOR INDEXING
MOV O.CAD,O.XXY
SUB O.RELT(R0),O.XXY ;COMPUTE DIFFERENCE
ASR R0 ;RESTORE N.
BR O.RCM2 ;PRINT RESULTS
;
;FILL MEMORY WORDS. LIMITS ARE THE SEARCH LIMITS.
;
O.FILL: MOV #2,O.BW ;SET MODE TO "OPEN WORD"
O.FIL1: TSTB O.SMFD ;DONT REACT UNLESS ";" WAS TYPED
BEQ O.ERR ;IF NOT TYPED, ERROR.
MOV O.CNST, R0 ;ACTUAL VALUE
MOV O.LOW,R4 ;USE SEARCH LIMITS FOR
MOV O.HI,R3 ; FILL LIMITS.
JSR 5,O.ST
BR O.DCD ;EXIT
;
;INITIALIZE MEMORY BYTES.
;
O.INIT: MOV #1,O.BW
BR O.FIL1 ;LET O.FILL DO THE WORK
; COMMAND DECODER - ODT11X
; ALL REGISTERS MAY BE USED (R0-R5),
O.ERR: MOV #'?,R0 ; ? TO BE TYPED
JSR 5,O.FTYP ; OUTPUT ?
O.DCD: CLR O.BW ;CLOSE ALL
JSR 5,O.CRLS ;TYPE *
O.DCD3: CLRB O.SMFD ;SEMICOLON FOUND FLAG
CLRB O.CMFD ;COMMA FOUND FLAG
CLRB O.MINS ;MINUS SIGN FOUND FLAG
O.DCD2: CLR R3 ;R3 IS A SAVE REGISTER FOR R2
CLR R5 ;R5 IS A SAVE REGISTER FOR R4
O.DCD1: CLR R4 ; R4 CONTAINS THE CONVERTED OCTAL
CLR R2 ; R2 IS THE NUMBER FOUND FLAG
O.SCAN: JSR 5,O.GET ;GET A CHAR, RETURN IN R0
O.SCN1: CMP #'0,R0 ;COMPARE WITH ASCII 0
BHI O.CLGL ;CHECK LEGALITY IF NON-NUMERIC
CMP #'7,R0 ;COMPARE WITH ASCII 7
BLO O.CLGL ;CHECK LEGALITY IF NOT OCTAL
BIC #177770,R0 ;CONVERT TO BCD
ASL R4 ; MAKE ROOM
ASL R4 ; IN
ASL R4 ; R4
ADD R0,R4 ;PACK THREE BITS IN R4
INC R2 ;R2 HAS NUMERIC FLAG
BR O.SCAN ; AND TRY AGAIN
O.CLGL: CLR R1 ;CLEAR INDEX
O.LGL1: CMPB R0,O.LGCH(R1) ;DO THE CODES MATCH?
BEQ O.LGL2 ;JUMP IF YES
INC R1 ; SET INDEX FOR NEXT SEARCH
CMP R1,#O.CLGT ;IS THE SEARCH DONE?
BHIS O.ERR ; OOPS!
BR O.LGL1 ;RE-LOOP
O.LGL2: TSTB O.MINS ;IF MINUS WAS NOT TYPED
BEQ O.LGL4 ;DO NOT NEGATE K
NEG R4 ;OTHERWISE, TAKE 2'S COMPLEMENT.
O.LGL4: TSTB O.CMFD ;IF A COMMA NOT TYPED,
BEQ O.LGL3 ;SKIP NEXT INSTRUCTION.
ADD O.BIAS,R4 ;OTHERWISE, ADD RELOC. BIAS TO (R4)
O.LGL3: CLRB O.MINS ;REINITIALIZE MINUS-TYPED SWITCH FOR NXT SCAN
ASL R1 ;MULTIPLY BY TWO
JMP @O.LGDR(R1) ;GO TO PROPER ROUTINE
O.LGDR: O.SEMI ; ; SEMICOLON
O.WRD ; / OPEN WORD
O.BYT ; \ OPEN BYTE -BACK SLASH
O.CRET ; CARRIAGE RETURN CLOSE
O.REGT ; $ REGISTER OPS
O.GO ; G GO TO ADDRESS K
O.OP1 ; MODIFY, CLOSE, OPEN NEXT
O.ORPC ; "BACKARROW" OPEN RELATED, INDEX - PC (BACK ARROW)
O.OLD ; < RETURN TO OLD SEQUENCE AND OPEN
O.BACK ; ^ OPEN PREVIOUS (UP ARROW)
O.COMM ; , COMMA. SEPERATES REL.REG. FROM INCREMENT
O.OFST ; O OFFSET
O.WSCH ; W SEARCH WORD
O.EFF ; E SEARCH EFFECTIVE ADDRESS
O.BKPT ; B BREAKPOINTS
O.PROC ; P PROCEED
O.ORAB ; @ OPEN RELATED, ABSOLUTE
O.ORRB ; > OPEN RELATED, REL. BRANCH
O.SNGL ; S SINGLE INSTRUCTION MODE
O.REL ; R RELOCATION PROCESSING
O.CNS ; C CONSTANT REGISTER PROCESSING
O.MIN ; - MINUS, NEGATES NUMBER TYPED IN
O.FILL ; F FILL MEMORY WORDS FROM THE CONSTANT REGISTER
O.INIT ; I INITIALIZE MEMORY BYTES FROM THE CONSTANT REGISTER
O.RCMP ; ! PRINT CURRENT OPENED ADDRESS IN REL. FORM
O.MOD ; X RETYPE OPENED CONTENTS, MOD40
O.ALF ; A ACCEPT ASCII INPUT
O.CTLC ; ^C EXIT TO MONITOR
O.LGL = .-O.LGDR ;LGL MUST EQUAL 2X CHLGT ALWAYS
; SEMI-COLON PROCESSOR
O.SEMI: MOV R2,R3 ;A SEMI-COLON HAS BEEN RECEIVED
MOV R4,R5 ;NUMERIC FLAG TO R3, CONTENTS TO R5
INCB O.SMFD ;SET SEMICOLON FOUND FLAG
CLRB O.CMFD ;RESET COMMA FOUND FLAG
BR O.DCD1 ;GO BACK FOR MORE
; PROCESS / AND \ - OPEN WORD OR BYTE
;INPUT - IF R2 IS NON-ZERO A NEW REXP HAS BEEN TYPED IN
;INPUT - -ADDRESS OF WORD TO BE OPENED IS IN R4
O.WRD: MOV #2,O.BW ;OPEN WORD
BR O.WB1
O.BYT1: ROL R4 ;GET THE ADDRESS BACK
O.BYT: MOV #1,O.BW ;OPEN BYTE
O.WB1: TST R2 ;GET VALUE IF R2 IS NON-ZERO
BNE O.WB4 ;BRANCH IF NUMBER INPUT
TSTB O.CMFD ;TEST FOR ","AND";"
BEQ O.WB2
O.WB3: JMP O.ERR ;ERROR IF PRESENT WITHOUT NUMBER.
O.WB2: TSTB O.SMFD
BNE O.WB3
BR O.WRD1 ;NO NUMBER - REOPEN PREVIOUS LOCATION
O.WB4: MOV R4,O.DOT ;PUT VALUE IN DOT
MOV R4,O.CAD ; ALSO IN CAD
O.WRD1: CMP #1,O.BW ;CHECK BYTE MODE
BEQ O.WRD2 ;JUMP IF BYTE
MOV O.CAD,R4
ASR R4 ;MOVE ONE BIT TO CARRY
BCS O.BYT1 ;JUMP IF ODD ADDRESS
MOV @O.CAD,R0 ;GET CONTENTS OF WORD
BR O.WRD3
O.WRD2: MOVB @O.CAD,R0 ;GET CONTENTS OF BYTE
O.WRD3: JSR 5,O.CADV ;GO GET AND TYPE OUT @CAD
CMP #1,O.BW ;CHECK IF BYTE MODE.
BNE O.DCD3 ;IF NOT WE'RE DONE. ELSE:
MOVB #'=,R0 ;TYP "=" AND THEN THE ASCII BYTE
JSR 5,O.FTYP
MOVB @O.CAD,R0
JSR 5,O.FTYP
MOVB #' ,R0
JSR 5,O.FTYP
JMP O.DCD3 ;GO BACK TO DECODER
; PROCESS CARRIAGE RETURN
O.CRET: JSR PC,O.CLSE ;CLOSE LOCATION
O.DCDA: JMP O.DCD ;RETURN TO DECODER
O.ERR3: JMP O.ERR ; INTERMEDIATE HELP
; PROCESS , OPEN NEXT WORD
O.OLD: INCB O.SEQ ;SET FLAG TO LATER RESTORE CAD
O.OP1: TST O.BW ; RECEIVED
O.ERR2: BEQ O.ERR3 ;ERROR IF NOTHING IS OPEN
JSR PC,O.CLSE ;CLOSE PRESENT CELL
TST O.SEQ ;SHOULD CAD BE RESTORED?
BEQ O.OP5 ;BRANCH IF NOT
MOV O.DOT,O.CAD ;RESTORE PREVIOUS SEQUENCE
CLRB O.SEQ ;RESET FLAG; NO LONGER NEEDED
O.OP5: ADD O.BW,O.CAD ;GENERATE NEW ADDRESS
O.OP2: MOV O.CAD,O.DOT ;INITIALIZE DOT
O.OP2A: JSR 5,O.CRLF ;
MOV O.BW,-(SP) ;SAVE BW
MOV #2,O.BW ;SET TO TYPE FULL WORD ADDRESS
MOV O.CAD,R0 ;NUMBER TO TYPE
JSR 5,O.RORA ; CHECK FORMAT
MOV @SP,O.BW ;RESTORE BW
MOV #27534,R0 ;PUT "/\" IN R0
CMP #1,(SP)+ ;IS IT BYTE MODE?
BEQ O.OP4 ;JUMP IF YES
SWAB R0 ;TYPE A /
O.OP4: JSR 5,O.FTYP ;TYPE THE LOW BYTE OF R0
BR O.WRD1 ;GO PROCESS IT
; PROCESS ^, OPEN PREVIOUS WORD
O.BACK: TST O.BW ; ^ RECEIVED
BEQ O.ERR2 ;ERROR IF NOTHING OPEN
JSR PC,O.CLSE
SUB O.BW,O.CAD ;GENERATE NEW ADDRESS
BR O.OP2 ;GO DO THE REST
; B HANDLER - SET AND REMOVE BREAKPOINTS
O.BKPT: MOV #O.TRTC,R0
ASL R4 ;MULTIPLY NUMBER BY TWO
TST R3
BEQ O.REMB ;IF R3 IS ZERO GO REMOVE BREAKPOINT
ASR R5 ;GET ONE BIT TO CARRY
BCS O.ERR1 ;BADNESS IF ODD ADDRESS
ASL R5 ;RESTORE ONE BIT
ADD #O.ADR1,R4
TST R2
BNE O.SET1 ;JUMP IF SPECIFIC CELL
O.SET: CMP R0,@R4 ;IS THIS CELL FREE?
BEQ O.SET1 ;JUMP IF YES
CMP R4,#O.BKP+O.ADR1 ;ARE WE AT THE END OF OUR ROPE
BHIS O.ERR1 ;YES, THERE IS NOTHING FREE
TST (R4)+ ;INCREMENT BY TWO
BR O.SET
O.SET1: CMP R4,#O.BKP+O.ADR1
BHI O.ERR1 ;ERROR IF TOO LARGE
MOV R5,@R4 ;SET BREAKPOINT
BR O.DCDA ;RETURN
O.REMB: TST R2
BEQ O.RALL ;GO REMOVE ALL
CMP R4,#O.BKP
BHI O.ERR1 ;JUMP IF NUMBER TOO LARGE
MOV R0,O.ADR1(R4) ;CLEAR BREAKPOINT
CLR O.CT(R4) ;CLEAR COUNT ALSO
O.DCDB: BR O.DCDA
O.RALL: CLR R4
MOV #O.TRTC,R0
O.RM1: CMP R4,#O.BKP+2 ;ALL DONE?
BHI O.DCDA ;JUMP IF YES
MOV R0,O.ADR1(R4) ;RESET BKPT
MOV #TRT,O.UIN(R4) ;RESET CONTENTS OF TABLE
CLR O.CT(R4) ;CLEAR COUNT
TST (R4)+ ;INCREMENT BY TWO
BR O.RM1
; PROCESS O, COMPUTE OFFSET
O.OFST: CMP #2,O.BW ;CHECK WORD MODE
BNE O.ERR1 ;ERROR IF NOT CORRECT MODE
MOV #' ,R0 ;TYPE ONE BLANK
JSR 5,O.FTYP ; AS A SEPARATOR
TST R3 ;WAS SEMI-COLON TYPED?
BEQ O.ERR1 ;NO, CALL IT AN ERROR
O.OF2: SUB O.CAD,R5 ;COMPUTE
DEC R5
DEC R5 ; 16 BIT OFFSET
MOV R5,R0
JSR 5,O.CADV ;NUMBER IN R0 - WORD MODE
MOV R5,R0
ASR R0 ;DIVIDE BY TWO
BCS O.OF1 ;ERROR IF ODD
CMP #-200,R0 ;COMPARE WITH -200
BGT O.OF1 ;DO NOT TYPE IF OUT OF RANGE
CMP #177,R0 ;COMPARE WITH +177
BLT O.OF1 ;DO NOT TYPE IF OUT OF RANGE
DEC O.BW ;SET TEMPORARY BYTE MODE
JSR 5,O.CADV ;NUMBER IN R0 - BYTE MODE
INC O.BW ;RESTORE WORD MODE
O.OF1: JMP O.DCD3 ;ALL DONE
O.ERR1: JMP O.ERR ;INTERMEDIATE HELP
.EOT ;END OF TAPE #2
;
; SEARCHES - $MSK HAS THE MASK
; $MSK+2 HAS THE FWA
; $MSK+4 HAS THE LWA
O.EFF: INC R1 ;SET EFFECTIVE SEARCH
BR O.WDS
O.WSCH: CLR R1 ;SET WORD SEARCH
O.WDS: TST R3 ;CHECK FOR OBJECT FOUND
BEQ O.ERR1 ;ERROR IF NO OBJECT
MOV #2,O.BW ;SET WORD MODE
MOV O.MSK+2,R2 ;SET ORIGIN
MOV O.MSK,R4 ;SET MASK
COM R4
O.WDS2: CMP R2,O.MSK+4 ; IS THE SEARCH ALL DONE?
BHI O.DCDB ; YES
MOV @R2,R0 ; GET OBJECT
TST R1 ;NO
BNE O.EFF1 ;BRANCH IF EFFECTIVE SEARCH
MOV R0,-(SP)
MOV R5,R3 ;EXCLUSIVE OR
BIC R5,R0 ; IS DONE
BIC (SP)+,R3 ; IN A VERY
BIS R0,R3 ; FANCY MANNER HERE
BIC R4,R3 ;AND RESULT WITH MASK
O.WDS3: BNE O.WDS4 ;RE-LOOP IF NO MATCH
MOV R4,-(SP) ;REGISTERS R2,R4, AND R5 ARE SAFE
MOV R1,-(SP) ;SAVE R1
MOV R2,-(SP) ;SAVE R2
MOV R3,-(SP)
JSR 5,O.CRLF
MOV R2,R0 ;GET READY TO TYPE
JSR 5,O.RORA ; CHECK FORMAT
MOV #'/,R0 ;SLASH TO R0
JSR 5,O.FTYP ;TYPE IT
MOV @R2,R0 ;GET CONTENTS
JSR 5,O.CADV ; TYPE CONTENT
MOV (SP)+,R3
MOV (SP)+,R2 ;RESTORE R2
MOV (SP)+,R1 ;RESTORE R1
MOV (SP)+,R4 ; RESTORE R4
;HAS CTRL/U BEEN STRUCK?
JSR R5,O.CU ;CHECK FOR ^U
O.WDS4: TST (R2)+ ;INCREMENT TO NEXT CELL AND
BR O.WDS2 ; RETURN
O.EFF1: CMP R0,R5 ; IS (X)=K?
BEQ O.WDS3 ;TYPE IF EQUAL
MOV R0,R3 ;(X) TO R3
ADD R2,R3 ;(X)+X
INC R3
INC R3 ;(X)+X+2
CMP R3,R5 ;IS (X)+X+2=K?
BEQ O.WDS3 ;BRANCH IF EQUAL
BIC #177400,R0 ;WIPE OUT EXTRANEOUS BITS
MOVB R0,R0
CCC
ASL R0 ;MULTIPLY BY TWO
INC R0
INC R0
ADD R2,R0 ;ADD PC
CMP R0,R5 ;IS THE RESULT A PROPER REL. BRANCH?
BR O.WDS3
; PROCESS G - GO
O.GO: TSTB O.SMFD ;WAS ";" TYPED?
BEQ O.ERR1 ;BR IF NOT TYPED
TST R3 ;WAS K; TYPED?
BEQ O.ERR1 ; TYPE ? IF NOT
MOVB #O.BKP+3,O.P ;CLEAR PROCEED
ASR R5 ;CHECK LOW ORDER BIT
BCS O.ERR1 ;ERROR IF ODD NUMBER
ASL R5 ;RESTORE WORD
MOV R5,O.UPC ;SET UP NEW PC
MOVB #O.STM,-(SP) ;SET HIGH PRIORITY
JSR PC,O.WST
JSR 5,O.RSTT ;RESTORE TELETYPE
O.TBIT: CLRB O.T ;CLEAR
BIS #O.TBT,O.UST ; BOTH T-BIT FLAGS
TSTB O.S ;SEE IF WE NEED A T BIT
BNE O.GO2 ;IF NOT GO NOW
BIC #O.TBT,O.UST ;SET TH T BIT
O.GO1: JSR 5,O.RSB ;RESTORE BREAKPOINTS
O.GO2: JSR 0,O.RSR ;RESTORE REGISTERS
MOV O.UST,-(SP) ; AND STATUS
MOV O.UPC,-(SP) ; AND PC
NOP ; CHANGE TO HALT FOR DEBUGGING
MOV O.UST,-(SP) ; MOV IN STATUS FIRST W/O T BIT
BIC #O.TBT,(SP) ; SO INTERRUPTS CAN HAPPEN BEFORE
JSR PC,O.WST ; RTT TURNS ON THE T BIT.
O.RTIT: RTT ; CHANGED TO RTI WHEN RUNNING ON /05 OR /20
; PROCESS P - PROCEED
; ONLY ALLOWED AFTER A BREAKPOINT
O.PROC: TSTB O.SMFD ;WAS ";" TYPED?
BEQ O.ERR1 ;BR IF NOT TYPED
MOVB O.P,R0
TSTB R0 ;CHECK LEGALITY OF PROCEED
BLT O.ERR1 ;NOT LEGAL
TST R2 ;CHECK FOR ILLEGAL COUNT
BNE O.ERR1 ;JUMP IF ILLEGAL
TST R3 ;WAS COUNT SPECIFIED?
BEQ O.PR1 ;NO
MOV R5,O.CT(R0) ;YES, PUT AWAY COUNT
O.PR1: MOVB #O.STM,-(SP) ;FORCE HIGH PRIORITY
JSR PC,O.WST
JSR 5,O.RSTT ;RESTORE TTY
O.C1: CMPB O.P,#O.BKP ;SEE IF A REAL ONE OR A FAKE
BGT O.TBIT ;BRANCH IF FAKE
TSTB O.S ;SEE IF SINGLE INSTRUCTION MODE
BNE O.TBIT ;IF SO EXIT NOW
MOVB #O.STM,-(SP) ;SET HIGH PRIORITY
JSR PC,O.WST
INCB O.T ;SET T-BIT FLAG
BIS #O.TBT,O.UST ;SET T-BIT
BR O.GO2
; BREAKPOINT HANDLER
O.BRK: MOV (SP)+,O.UPC ;PRIORITY IS 7 UPON ENTRY
MOV (SP)+,O.UST ;SAVE STATUS AND PC
MOVB #O.BKP+3,O.P ;TELL ;P THAT WE CAN CONTINUE
O.BK1: JSR 0,O.SVR ;SAVE VARIOUS REGISTERS
TSTB O.T ;CHECK FOR T-BIT SET
BNE O.TBIT ;JUMP IF SET
JSR 5,O.REM ;REMOVE BREAKPOINTS
TSTB O.PRI ;CHECK IF PRIORITY
BPL O.BK2 ; IS AS SAME AS USER PGM
MOVB O.UST,R5 ;PICK UP USER UST IF SO
BR O.BK3
O.BK2: MOVB O.PRI,R5 ;OTHERWISE PICK UP ACTUAL PRIORITY
CCC ;CLEAR CARRY
RORB R5 ;SHIFT LOW ORDER BITS
RORB R5 ; INTO
RORB R5 ; HIGH ORDER
RORB R5 ; POSITION
O.BK3: BIC #O.TBT,R5 ;CLEAR POSSIBLE T BIT (S/I MODE)
MOVB R5,-(SP) ;PUT THE STATUS AWAY WHERE IT BELONGS
JSR PC,O.WST
MOV O.UPC,R5 ;GET PC, IT POINTS TO THE TRT
TSTB O.S ;SEE IF IT WAS SINGLE INSTRUCTION FUN
BMI O.B4 ;IF SO HANDLE THERE
TST -(R5)
MOV R5,O.UPC
MOV #O.BKP,R4 ;GET A COUNTER
O.B1: CMP R5,O.ADR1(R4) ;COMPARE WITH LIST
BEQ O.B2 ;JUMP IF FOUND
DEC R4
DEC R4
BGE O.B1 ;RE-LOOP UNTIL FOUND
JSR 5,O.SVTT ;SAVE TELETYPE STATUS
JSR 5,O.CRLF
MOV #O.BD,R4 ;ERROR, NOTHING FOUND
MOV #O.BD+1,R3
JSR 5,O.TYPE ;OUTPUT "BE" FOR BAD ENTRY
MOV R5,R0
ADD #2,O.UPC ;POP OVER THE ADJUSTMENT ABOVE
BR O.B3 ; OR CONTINUE
O.B4: MOVB #O.BKP+2,R4 ;SET BREAK POINT HIGH + 1
MOV R5,O.ADR1(R4) ;STORE NEXT PC VALUE FOR TYPE OUT
BR O.B2
O.B2: MOVB R4,O.P ;ALLOW PROCEED
DEC O.CT(R4)
BGT O.C1 ;JUMP IF REPEAT
MOV #1,O.CT(R4) ;RESET COUNT TO 1
JSR 5,O.SVTT ;SAVE TELETYPE STATUS, R4 IS SAFE
MOV #'B,R0
JSR 5,O.FTYP ;TYPE "B"
MOVB O.P,R0 ;CONVERT BREAKPOINT NUMBER TO ASCII
ADD #140,R0
ASR R0
JSR 5,O.FTYP
MOV #';,R0
JSR 5,O.FTYP ; TYPE
MOV #2,O.BW ; SET WORD MODE
MOVB O.P,R4
MOV O.ADR1(R4),R0 ;GET ADDRESS OF BREAK
O.B3: JSR 5,O.RORA ; CHECK FORMAT
JMP O.DCD ;GO TO DECODER
; SAVE REGISTERS R0-R6
; INTERNAL STACK
O.SVR: MOV (SP)+,O.XXX ;PICK REGISTER FROM STACK AND SAVE
MOV SP,O.USP ;SAVE USER STACK ADDRESS
MOV #O.USP,SP ;SET TO INTERNAL STACK
MOV R5,-(SP) ;SAVE
MOV R4,-(SP) ; REGISTERS
MOV R3,-(SP) ;1
MOV R2,-(SP) ; THRU
MOV R1,-(SP) ; 5
MOV O.XXX,-(SP) ;PUT SAVED REGISTER ON STACK
TST -(SP)
RTS R0
; RESTORE REGISTERS R0-R6
O.RSR: TST (SP)+ ;POP THE EXTRA CELL
MOV (SP)+,O.XXX ;GET R0 FROM STACK
MOV (SP)+,R1 ;RESTORE
MOV (SP)+,R2 ; REGISTERS
MOV (SP)+,R3 ; 1
MOV (SP)+,R4 ; THRU
MOV (SP)+,R5 ; 5
MOV O.USP,SP ;RESTORE USER STACK
MOV O.XXX,-(SP) ;PUT R0 ON USER STACK
RTS R0
; RESTORE BREAKPOINTS 0-7
O.RSB: MOV #O.BKP,R4 ;RESTORE ALL BREAKPOINTS
O.RS1: MOV @O.ADR1(R4),O.UIN(R4) ;SAVE CONTENTS
MOV O.TRTC,@O.ADR1(R4) ;REPLACE WITH TRAP
DEC R4
DEC R4
BGE O.RS1 ;RE-LOOP UNTIL DONE
RTS R5 ; THEN QUIT
; SAVE TELETYPE STATUS
O.SVTT: MOVB O.RCSR,O.CSR1 ;SAVE R C/SR
MOVB O.TCSR,O.CSR2 ;SAVE T C/SR
CLRB O.RCSR ;CLEAR ENABLE AND MAINTENANCE
CLRB O.TCSR ; BITS IN BOTH C/SR
O.SVT1: TSTB O.TCSR ;LOOP UNTIL READY BIT COMES ON
BPL O.SVT1 ;BR IF BIT NOT ON
RTS R5
; RESTORE TELETYPE STATUS
O.RSTT: JSR 5,O.CRLF
TSTB O.TCSR ;WAIT READY
BPL .-4 ; ON PRINTER
BIT #4000,O.RCSR ;CHECK BUSY FLAG
BEQ O.RSE1 ;SKIP READY LOOP IF NOT BUSY
TSTB O.RCSR ;WAIT READY
BPL .-4 ; ON READER
O.RSE1: MOVB O.CSR1,O.RCSR ;RESTORE
MOVB O.CSR2,O.TCSR ; THE STATUS REGISTERS
RTS R5
; REMOVE BREAKPOINTS 0-7
; IN THE OPPOSITE ORDER OF SETTING
O.REM: TSTB O.S ;SEE IF SINGLE INSTRUCTION IS GOING
BNE O.R2 ;EXIT IF SO
CLR R4 ;REMOVE ALL BREAKPOINTS
O.R1: MOV O.UIN(R4),@O.ADR1(R4) ;CLEAR BREAKPOINT
INC R4
INC R4
CMP R4,#O.BKP
BLE O.R1 ;RE-LOOP UNTIL DONE
O.R2: RTS R5 ;THEN QUIT
; TYPE OUT CONTENTS OF WORD OR BYTE WITH ONE TRAILING SPACE
; WORD IS IN R0
O.CADV: MOV #6,R3 ;# OF DIGITS
MOV #-2,R4 ;# OF BITS FIRST-3
CMP #1,O.BW ;SEE IF WORD MODE
BNE O.SPC ;BRANCH IF SO
SUB #3,R3 ;ONLY DO 3 DIGITS
INC R4 ;DO 2 BITS FIRST
SWAB R0 ;AND TURN R0 AROUND
O.SPC: MOV R0,-(SP) ;SAVE R0
O.V0: ADD #3,R4 ;COMPUTE THE NUMBER OF BITS TO DO
CLR R0
O.V1: ROL (SP) ;GET A BIT
ROL R0 ;STORE IT AWAY
DEC R4 ;DECREMENT COUNTER
BGT O.V1 ;LOOP IF MORE BITS NEEDED
ADD #'0,R0 ;CONVERT TO ASCII
JSR R5,O.FTYP ;TYPE IT
DEC R3 ;SEE IF MORE DIGITS TO DO
BGT O.V0 ;LOOP IF SO
MOVB #' ,R0 ;SET UP FOR TRAILING SPACE
TST (SP)+ ;GET RID OF JUNK
BR O.FTYP
;
;O.CLRR CLEAR RELOCATION REGS
; I.E., SET THEM TO A HIGH MEM LOC. (-1)
; R1,R0 CLOBBERED
;
O.CLRR: MOV #O.RELT,R1
MOV #-1,R0
MOV R0,(R1)+
MOV R0,(R1)+
MOV R0,(R1)+
MOV R0,(R1)+
MOV R0,(R1)+
MOV R0,(R1)+
MOV R0,(R1)+
MOV R0,(R1)
RTS R5
;
.EOT ;END OF TAPE #3
; TYPE ONLY ONE CHARACTER (CONTAINED IN R0)
O.FTYP: TSTB O.TCSR
BPL .-4
BIC #177400,R0 ;CLEAR HIGH BYTE,SHOULD NOT
;CONTAIN INPORTANT INFO.
BEQ O.FTY3
CMP #176,R0 ;PRINT ? FOR 177;16-37
BLO O.FTY2 ; 1-10 AND 200-377.
CMP #37,R0
BLO O.FTY3
CMP #15,R0
BLO O.FTY2
CMP #10,R0
BLO O.FTY3
O.FTY2: MOV #'?,R0
O.FTY3: MOVB R0,O.TDB
O.TYP1: RTS R5
; GENERAL CHARACTER INPUT ROUTINE -- ODT11X
; CHARACTER INPUT GOES TO R0
O.GET: TSTB O.RCSR ;WAIT FOR
BPL .-4 ; INPUT FROM KBD
MOVB O.RDB,R0 ;GET CHARACTER - STRIP OFF PARITY
BIC #177600,R0 ;STRIP OFF PARITY FROM CHARACTER
CMPB #3,R0 ;IS IT ^C?
BEQ O.GET1 ;IF SO, DO NOT ECHO
TSTB O.SCRN ;SHOULD WE ECHO ?
BNE O.GET2 ;BR IF YES
CMPB R0,#012 ;SEE IF A
BEQ O.GET1 ;IF SO SAVE THE PAPER
O.GET2: CMPB R0,#173
BGE O.NOLC
CMPB #140,R0 ;TEST FOR LOWER CASE
BGE O.NOLC
SUB #40,R0 ;CHAR IS LC-CONVERT TO UPPER CASE
O.NOLC: JSR 5,O.FTYP ;ECHO CHARACTER
BEQ O.GET ;IGNORE NULLS
TSTB O.SCRN ;SHOULD WE PASS ON SPACES?
BNE O.GET1 ;BR IF YES
CMPB #40,R0 ;CHECK FOR SPACES
BEQ O.GET ;IGNORE SPACES
O.GET1: RTS R5
; GENERAL CHARACTER OUTPUT ROUTINE - ODT11X
; ADDRESS OF FIRST BYTE IN R4,
; ADDRESS OF LAST BYTE IN R3, (R3)>(R4)
; EXPECTS LOCS 56,57 TO BE INITIALIZED BY MONITOR FOR FILL
; CHARACTERISTICS OF TERMINAL
; 56=CHAR TO BE FILLED AFTER
; 57=# OF NULLS TO FILL WITH
O.TYPE: CMP R3,R4 ;CHECK FOR COMPLETION
BLO O.TYP1 ; EXIT WHEN DONE
MOVB (R4)+,R0 ;GET A CHARACTER
JSR 5,O.FTYP ;TYPE ONE CHARACTER
CMPB R0,@#56 ;COMPARE CHAR AGAINST FILL REQUIREMENT
BNE O.TYPE ;NO FILL NEEDED
MOVB @#57,(PC)+ ;FILL COUNT INTO TEMP
O.FTMP: 0
CLR R0 ;FILL WITH NULLS
O.FLP: JSR R5,O.FTYP ;TYPE NULLS
DEC O.FTMP ;DECREASE COUNT
BGT O.FLP ;BRANCH IF NOT DONE
BR O.TYPE ;LOOP UNTIL DONE
;
;CHECKS FOR ^U. IF PRESENT, ECHOS IT
;GOES TO COMMAND DECODER. STACK GETS INITIALIZED
O.CU: CMPB O.RDB,#225 ;IS ^U IN TTY BUFFER
BNE O.TYP1 ;BR TO RETURN IF NOT
MOV #136,R0 ;PUT "^" IN R0
JSR R5,O.FTYP
MOV #125,R0 ;PUT U IN R0
JSR R5,O.FTYP
MOV #O.UR0,SP ;INT STACK
JMP O.DCD
;SUBROUTINE TO READ THE PS INDEPENDENT OF MACHINE
O.RRST: MOVB ST,O.UST ;STORE THE STATUS IN USER
;STATUS AREA.FOR AN LSI
;THIS IS CHANGED TO
;MFPS O.UST
RTS PC
;SUBROUTINE TO WRITE PS INDEPENDENT OF MACHINE
;CALL ROUTINE WITH PS VALUE
;ON THE STACK
O.WST: MOVB 2(SP),ST ;STORE NEW PS VALUE
;THIS INSTRUCTION IS CHANGED FOR LSI
;TO MTPS 2(SP)
MOV (SP)+,(SP) ;PUT RETURN PC OVER SUB. ARGUMENT
RTS PC ;TO RETURN WITHOUT IT ON THE STACK
;
;SUBROUTINE TO LOCATE RELOCATION REGISTER NEAREST BUT STILL
;BELOW THE ADDRESS IN R0. RETURNS WITH THE REGISTER
;NUMBER IN R0, AND WITH THE DISTANCE BETWEEN THE REGISTER
;AND (R0) IN O.XXY
;IF NO GOOD RELOC. REG. FOUND, R0 WILL = -1
O.LOC: MOV R0,O.LOC5 ;PUT R0 IN WORKINK LOCATION.
CLR R0
MOV #-1,O.XXX ;INITIALIZE RELOC. REG. INDEX
MOV #177777,O.XXY ;INITIALIZE DISTANCE TO A HIGH VALUE
O.LOC4: CMP R0,#O.RLR ;ARE WE DONE COMPARING?
BHI O.LOC1 ;BRANCH IF DONE
CMP O.RELT(R0),O.LOC5 ;IS CURR. RELOC. BIAS > (O.CAD)?
BHI O.LOC2 ;IF SO, BRANCH -- DON'T SUBTRACT, GET NEXT
MOV O.LOC5,R1 ;OTHERWISE TAKE THE DIFFERENCE
SUB O.RELT(R0),R1 ; OF CURR. RELOC. REG. AND O.CAD
CMP O.XXY,R1 ;IS THE RESULT THE SMALLEST SO FAR?
BHI O.LOC3 ;BRANCH IF YES (UNSIGNED CONDITIONAL)
O.LOC2: TST (R0)+ ;OTHERWISE, BUMP R0 FOR NEXT RELOC. REG.
BR O.LOC4 ;LOOP BACK FOR NEXT COMPARISON
O.LOC1: MOV O.XXX,R0 ;PUT REG.# IN R0
RTS 5 ;JOB OVER, RETURN
O.LOC3: MOV R1,O.XXY ;REMEMBER SMALLEST DIFFERENCE IN O.XXY
ASR R0 ;AND ASSOCIATED REGISTER NUMBER
MOV R0,O.XXX ; IN O.XXX
ASL R0 ;RESTORE R0 TO ORIGINAL VALUE
BR O.LOC2 ;GO FO NEXT COMPARISON.
O.LOC5: .WORD ;TEMP LOCATION.
;
;
;SET A SEGMENT OF MEMORY TO A GIVIEN VALUE. (ENTERED VIA R5)
;FIRST WORD OR BYTE ADDRESS IS IN R4, =TO R3 AT EXIT
;LAST WORD OR BYTE ADDRESS IS IN R3
;BYTE OR WORD VALUE IS IN R0
;BYTE OR WORD MODE IS SPECIFIED BY O.BW
;
O.ST:
O.ST2: CMP #1,O.BW ;IF NOT BYTE MODE, ASSUME WORD
BEQ O.ST1 ;BRANCH IF BYTE MODE
MOV R0,(R4)+ ;DEPOSIT WORD VALUE, BUMP R4 BY 2
O.ST3: CMP R4,R3 ;ARE WE DONE?
BLOS O.ST2 ;BRANCH IF NOT DONE
RTS 5 ;OTHERWISE EXIT
O.ST1: MOVB R0,(R4) ;DEPOSIT BYTE VALUE
INC R4 ;BUMP R4 BY 1
BR O.ST3 ;GO TO TEST IF DONE
; CLOSE WORD OR BYTE AND EXIT,
; UPON ENTERING, R2 HAS NUMERIC FLAG, R4 HAS CONTENTS
O.CLSE: TST R2 ;IF NO NUMBER WAS TYPED THERE IS
BEQ O.CLS1 ;NO CHANGE TO THE OPEN CELL
CMP #1,O.BW
BEQ O.CLS2 ;JUMP IF BYTE MODE
BHI O.CLS1 ;JUMP IF ALREADY CLOSED
O.CLS4: MOV R4,@O.CAD ;STORE WORD
O.CLS3: BR O.CLS1
O.CLS2: MOVB R4,@O.CAD ;STORE BYTE
O.CLS1: RTS PC
O.CRLF: MOV #O.CR+1,R3 ;LWA
BR O.CRS
O.CRLS: MOV #O.CR+2,R3 ;LWA *
O.CRS: MOV #O.CR,R4 ;FWA
JSR 5,O.TYPE ;TYPE SOMETHING
RTS R5
;SUBROUTINE O.RORA
;FUNCTION: DECIDE IF AN ADDRESS IS
;TO BE PRINTED IN ABSOLUTE OR IN RELATIVE
;FORM. IF THE FLAG O.FORM=0 THEN PRINT
;IN RELATIVE FORM, OTHERWISE PRINT IN
;ABSOLUTE FORM.
;IF THE ADDRESS IS TO BE PRINTED IN RELATIVE
;FORM,
;THEN THE ADDRESS WILL BE PRINTED OUT
;RELATIVE TO A RELOCATION REGISTER NEAREST
;BUT STILL BELOW THE ADDRESS. IF NO SUCH
;RELOCATION REGISTER EXIST THEN THE
;ADDRESS WILL BE PRINTED IN ABSOLUTE FORM
;INPUT: THE ADDRESS TO BE PRINTED IS IN R0.
;DATA SAVED: R0 CONTAINING THE ADDRESS TO BE
;PRINTED, AND LOCATION O.CAD CONTAINING
;THE CURRENT ADDRESS WERE SAVED AND RESTORED.
;CALLED: JSR 5,O.RORA
O.RORA: CMP #0,O.FORM ;CHECK FORMAT
BEQ O.NOTA ; GO TO O.NOTA IF RELATIVE
O.ABS: JSR 5,O.CADV ;PRINT ABSOLUTE ADDRESS
RTS R5
O.NOTA: MOV R0,O.TMP2 ;SAVE R0
JSR 5,O.LOC ; FIND BEST N
TST R0 ;IF = -1, PRINT IN ABS.
BLT O.ABS1
ADD #60,R0 ; CONVERT N TO ANSCII
JSR 5,O.FTYP ; TYPE N
MOV #',,R0 ; PREPARE INPUT FOR O.FTYP
JSR 5,O.FTYP ; TYPE COMMA
MOV O.BW,-(SP) ; SAVE O.BW
MOV #2,O.BW ;ARTIFICIALLY SET MODE FOR WORDS
MOV O.XXY,R0 ;PREPARE INPUT FOR O.CADV
JSR 5,O.CADV ;TYPE RELATIVE AMOUNT
MOV (SP)+,O.BW ;RESTORE MODE
MOV O.TMP2,R0 ; RESTORE R0
RTS R5
O.ABS1: MOV O.TMP2,R0 ;RESTORE R0,CAD BEFORE
BR O.ABS
;
; MOD40 PACK - ENTERED WITH JSR PC, PACK00
;
; INPUT: R0=ADR OF MOD40 WORD (1 WORD)
; R1=ADR OF ASCII CHARACTERS (3 CHARS)
;
; OUTPUT: R1 POINTS ONE PAST END OF ASCII STRINT
; THE MOD40 WORD IS FORMED AS
; N=C1*40^2+C2*40+C3
;
; R2,R3,R4 ARE CLOBBERED
PACK00:
PACK01: MOV #-3,R4 ;LOOP CT.
CLR R2 ;0 SUM
PACK05: MOVB (R1)+,R3 ;GET NEXT ASCII CHAR.
CMPB #' ,R3
BEQ PACK02 ;"BLANK"
CMPB #'$,R3
BEQ PACK04 ;"$"
CMPB R3,#'A
BLO PACK03 ;"." OR "0-9"
SUB #40,R3 ;"A-1"
PACK02: SUB #16,R3
PACK03: SUB #11,R3
PACK04: SUB #11,R3
; MULT R2 BY 40.
ASL R2 ;2*R2
ASL R2 ;4*R2
ASL R2 ;8*R2
MOV R2,-(SP) ;STACK 8*R2
ASL R2 ;16.*R2
ASL R2 ;32.*R2
ADD (SP)+,R2 ;40.*R2
; INCLUDE CURRENT CHARACTER
ADD R3,R2
INC R4 ;DONE 3 CHARS?
BLT PACK05 ;NO
MOV R2,(R0)+ ;YES-STORE MOD40 WORD
RTS PC ;EXIT
;
; MOD40 UNPACK - ENTERED VIA JSR PC,UNPA00
;
; INPUT: R0=ADR OF MOD40 NUMBER (1 WORD)
; R1=ADR OF ASCII STRING (3 BYTES)
;
; OUTPUT: R1 POINTS ONE PAST LAST GENERATED CHARACTER
;
;
; IF N IS THE MOD40 NUMBER, THEN
; N=C1*50 ^ 2+C2*50+C3
; THUS, N/50^2 IS C1 AND THE REMAINDER IS C2*50+C3
; THE REMAINDER IS DIVIDED BY 50 TO GET C2 ETC.
;
UNPA00:
UNPA07: MOV #-3,R5 ;MINOR LOOP COUNT
MOV (R0),R0 ;GET MOD40 WORD
MOV #COEFF,R2 ;PTR TO COEFFICIENT TABLE
UNPA06: CLR R3 ;0 QUOTIENT
; DIVIDE BY COEFFICIENTS
UNPA02: CMP R0,(R2) ;DONE WITH DIVIDE?
BLO UNPA01 ;YES
SUB (R2),R0 ;NO-SUBTRACT COEFF.
INC R3 ;ADD 1 TO QUOTIENT
BR UNPA02
; DIVIDE DONE. QUOT IN R3, REMAINDER IN R0
; CONVERT TO AN ASCII CHARACTER
UNPA01: TSTB R3
BEQ UNPA03 ;"BLANK"
CMPB R3,#33
BEQ UNPA05 ;"$"
BGT UNPA04 ;"." OR "0-9"
ADD #40,R3 ;"A-Z"
UNPA03: ADD #16,R3
UNPA04: ADD #11,R3
UNPA05: ADD #11,R3
MOVB R3,(R1)+ ;STORE CHARACTER
TST (R2)+ ;ADVANCE TO NEXT COEFF.
INC R5 ;DONE 3 CHARS?
BLT UNPA06 ;NO-DO MORE
MOV (SP),R0 ;RESTORE ORIGINAL R0 AND
TST (R0)+ ;MOVE TO NEXT WORD
RTS PC
;
; COEFFICIENT TABLE
;
COEFF: +1600. ;40. ^ 2
+40. ;40. ^ 1
+1. ;40. ^ 0
O.BW: .BYTE 0 ; =0 - ALL CLOSED
; =1 - BYTE OPEN,
; =2 - WORD OPEN
.EVEN
O.CAD: 0 ; CURRENT ADDRESS
O.DOT: 0 ; ORIGIN ADDRESS
O.XXX: .WORD 0 ;TEMPORARY STORAGE
O.XXY: .WORD 0 ;2ND WORD OF TEMPORARY STORAGE
O.SEQ: .BYTE 0 ;CHANGE SEQUENCE INDICATOR
O.WDFG: .BYTE 0 ;SEARCH FLAG = 1 - EFFECTIVE
; = 0 - WORD
O.S: .BYTE 0 ;SINGLE INSTRUCTION FLAG
;0 IF NOT ACTIVE
;-1 IF ACTIVE
;NO BREAK BOINTS MAY BE SET WHILE IN
;SINGLE INSTRUCTION MODE
O.T: .BYTE 0 ; T-BIT FLAG
O.P: .BYTE 0 ;PROCEED FLAG = -2 IF MANUAL ENTRY
; -1 IF NO PROCEED ALLOWED
; 0-7 IF PCEED ALLOWED
O.CSR1: .BYTE 0 ;SAVE CELL - R C/SR
O.CSR2: .BYTE 0 ;SAVE CELL - T C/SR
O.CMFD: .BYTE 0 ;COMMA FOUND SWITCH, =0 NO COMMA FOUND
; =1 COMMA FOUND
O.SMFD: .BYTE 0 ;SEMICOLON FOUND SWITCH
;=0 NO SEMICOLON FOUND
;=1 SEMICOLON FOUND
O.ALF1: .BYTE 0
O.ALF2: .BYTE 0
O.ALF3: .BYTE 0
O.SCRN: .BYTE 0 ;FLAG; 1=PASS SPACES ON FROM TTY
;ALSO, IF =1, IS ECHOED
O.ID: .BYTE 012
.BYTE 015
.BYTE 40
.ASCII /ODT V01-02 /
O.IDND=.-1
.EVEN
O.BD: .WORD "BE
O.BIAS: .WORD 0 ;CURRENT RELOCATION BIAS
O.MINS: .BYTE 0 ;MINUS SIGN TYPED (SWITCH)
;0=NO MINUS TYPED; 1=MINUS SIGN TYPED
.EVEN
O.TMP1: .WORD 0 ;SAVE CELL
O.TMP2: .WORD 0 ;SAVE CELL
O.CR: .BYTE 015 ;
.BYTE 012 ;
.BYTE '* ; *
O.LGCH: .BYTE '; ;
.BYTE '/ ; /
.BYTE '\ ; \ (BACK SLASH)
.BYTE 015 ; CARRIAGE RETURN
.BYTE '$ ; $
.BYTE 'G ; G
.BYTE 012 ;
.BYTE '_ ; _ (BACK ARROW)
.BYTE '< ; <
.BYTE '^ ; ^ (UP ARROW)
.BYTE ', ; ,
.BYTE 'O ; O
.BYTE 'W ; W
.BYTE 'E ; E
.BYTE 'B ; B
.BYTE 'P ; P
.BYTE '@ ; @
.BYTE '> ; >
.BYTE 'S ; S
.BYTE 'R ; R
.BYTE 'C ; C
.BYTE '- ; -
.BYTE 'F ; F
.BYTE 'I ; I
.BYTE '! ; !
.BYTE 'X ; X
.BYTE 'A ; A
.BYTE 003 ;CTRL C
O.CLGT = .-O.LGCH ;TABLE LENGTH
O.TL: .BYTE 'S ;DO 1
.BYTE 'P ;NOT 2
.BYTE 'M ;CHANGE 3
.BYTE 0 ;THE 4
.BYTE 0 ;ORDER 5
.BYTE 'C ; 6
.BYTE 'F ; 7
.BYTE 'R ; 10
.BYTE 0 ; 11
.BYTE 0 ; 12
.BYTE 0 ; 13
.BYTE 0 ; 14
.BYTE 0 ; 15
.BYTE 0 ; 16
.BYTE 0 ; 17
.BYTE 'B ; 20
O.LG = .-O.TL
.EVEN
O.TRTC: TRT ;TRACE TRAP PROTOTYPE
;THE ORDER OF THE FOLLOWING ENTRIES IS CRITICAL
. = O.ODT-144 ;ODT'S STACK IMMEDIATELY PRECEDES ODT
O.UR0: 0 ;USER R0
0 ; R1
0 ; R2
0 ; R3
0 ; R4
0 ; R5
O.USP: 0 ;USER SP
O.UPC: 0 ;USER PC
O.UST: 0 ;USER ST
O.PRI: 7 ;ODT PRIORITY
O.MSK: 0 ;MASK
O.LOW: 0 ;LOW LIMIT
O.HI: 0 ;HIGH LIMIT
O.CNST: 0 ;CONSTANT REGISTER
O.FORM: 0 ; FORMAT REGISTER
; IF $F=0 RELATIVE ADDRESSING
; ABSOLUTE OTHERWISE
;RELOCATION REGISTERS
O.RELT: -1,-1,-1,-1,-1,-1,-1,-1 ;INITIALLY SET TO A HIGH ADDR.
; BREAK POINT LISTS, ADR1 = ADDRESS OF BREAKPOINT,CT = COUNT,
; UIN = CONTENTS
O.ADR1:
. = .+O.BKP+4
O.CT:
. = .+O.BKP+4
O.UIN:
. = .+O.BKP+4
. = O.TRTC+2
.END O.ODT ;END OF TAPE #4
.TITLE VTCAL1 V02-05
;
; VTCALL, A LIBRARY OF SUBROUTINES TO
; SUPPORT THE VT11 DISPLAY PROCESSOR
;
; DEC-11-OVTHA-E
;
; COPYRIGHT (C) 1974,1975
;
; DIGITAL EQUIPMENT CORPORATION
; MAYNARD, MASSACHUSETTS 01754
;
; THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY
; ON A SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH
; THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS
; SOFTWARE, OR ANY OTHER COPIES THEREOF, MAY NOT BE PROVIDED
; OR OTHERWISE MADE AVAILABLE TO ANY OTHER PERSON EXCEPT
; FOR USE ON SUCH SYSTEM AND TO ONE WHO AGREES TO THESE
; LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE SOFTWARE
; SHALL AT ALL TIMES REMAIN IN DIGITAL.
;
; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO
; CHANGE WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED
; AS A COMMITMENT BY DIGITAL EQUIPMENT CORPORATION.
; DIGITAL ASSUMES NO RESPONSIBILITY FOR ANY ERRORS THAT
; MAY APPEAR IN THIS DOCUMENT
;
; DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE
; OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT
; WHICH IS NOT SUPPLIED BY DIGITAL.
;
; MARCH 1974
;
; D. VELTEN
;
; VERSION 02
;
; EDIT 5
; THE DISPLAY FILE HANDLER IS CONDITIONALIZED SO THAT IT
; MAY BE EASILY ADAPTED TO A VARIETY OF APPLICATIONS. IF NO
; CONDITIONS ARE SPECIFIED, THE HANDLER WILL HAVE THESE
; CHARACTERISTICS:
;
; - DISPLAY STOP AND LIGHT PEN INTERRUPT HANDLERS
; - SUBPICTURE STACK DEPTH OF 10
; - NAME REGISTER STACK DEPTH OF 10
; - MAXIMUM OF 2 USER MAIN DISPLAY FILES
; - RT11 SCROLLER LINK-UP CAPABILITY
; - TRACKING OBJECT
; - BASIC/GT-FORTRAN/GT FILE COMPATIBILITY
; - SUBROUTINE CALL SEQUENCE WILL BE:
; DJSR
; RETURN ADDR.
; SUBR. ADDR.
; TAG
; TO ALTER THE HANDLER DEFAULT STRUCTURE:
; DEFINE: RESULT:
;
; NOLINK CREATES STAND ALONE SYSTEM W/O SCROLL
; LINK. CALL .SCROL IS UNDEFINED.
;
; NOTRAK NO TRACK OBJECT. IMPLIED WHEN NOTAG OR
; NOLPEN ARE DEFINED.
;
; NOTAG NO BASIC/GT TAG STRUCTURE. CALLS .BLANK,
; .RESTR,.TRACK ARE UNDEFINED. CALL SEQ. IS:
; DJSR
; ADDR. OF SUBR.
;
; NOLPEN NO LIGHT PEN SUPPORT, .LPEN UNDEFINED
;
; NOSTAT NO STATUS DATA SUPPORT, .STAT UNDEFINED.
;
; NOUSER ONLY A SINGLE USER DISPLAY FILE MAY
; BE INSERTED AT AT TIME.
;
; NONAME NO NAME REGISTER STACK.
;
; NORT11 RT11 MONITOR DEPENDENCIES ARE REMOVED.
; NOLINK IS IMPLIED AND .SCROL IS UNDEFINED
; TO ALTER HANDLER DEFAULT PARAMETERS:
;
; DEFINE: DEFAULT(OCTAL): MEANING:
;
; SCRPOS 1750 SCROLL TOP Y POSITION
;
; STKSIZ 12 SUBPICTURE STACK DEPTH
;
; USERNM 2 MAX. # USER MAIN FILES
; THAT CAN BE CALLED BY HANDLR
;
; THE FOLLOWING ARE DISPLACEMENTS OF PARAMETERS WITHIN THE
; SCROLL LOGIC LOCATED ABOVE THE RMON FROM THE BEGINNING OF
; THE SCROLL LOGIC. THEY MUST BE REDEFINED IF THEIR POSITION
; CHANGES.
;
; TAG: DEFAULT USE
;
; SCLINK 6 SCROLL LINK SEGMENT
;
; SCMAX 4 MAX. LINE COUNT
;
; DISP 300 DISPL. FROM RMON (LOC. 54)
; TO CONFIG WD.
;
; THE VT11 HAS FLOATING VECTORS. IF THE VT11 IS INSTALLED AT
; A VECTOR OR DEVICE ADDRESS OTHER THAN DEFAULT, THESE
; PARAMETERS SHOULD BE REDEFINED:
;
; DEFINE: DEFAULT: MEANING:
;
; FVEC 320 DISPLAY STOP INT. TRAP ADDR.
;
; DPC 172000 FIRST DEVICE ADDR. (DISPLAY
; PROGRAM COUNTER).
;
.SBTTL INITIALIZATION (CLEAR) ROUTINE
; THIS ROUTINE CLEANS UP THE HANDLER AND RESETS COUNTERS AND
; POINTERS. IT REMOVES ALL CALLS TO USER FILES AND
; THE TRACK OBJECT.
R1=%1
SP=%6
PC=%7
DJMP=160000 ;DISPLAY JUMP
.CSECT $GT1
.IF DF NOTAG!NOLPEN
NOTRAK=1
.ENDC
.IF DF NORT11
NOLINK=1
.ENDC
.GLOBL $VINIT,$CUSER,$NULL,$VSTP,$VSTIN
.GLOBL $VFDEL,$DPC,$NR
.IF NDF NOSTAT
.GLOBL $TATBF
.ENDC
.IF NDF NOTRAK
.GLOBL $CTRAK,$TRAKC
.ENDC
.IF NDF NOLPEN
.GLOBL $LPBUF
.ENDC
.IF NDF NONAME
.GLOBL $NRBUF
.ENDC
$VINIT: MOV R1,-(SP)
JSR PC,$VSTP ;STOP THE DISPLAY
10$: MOV #$CUSER,R1 ;POINT TO FIRST USER CALL
1$: JSR PC,$VFDEL ;DELETE THE FILE
.IF NDF NOUSER
CMP #$NULL,R1 ;END OF USER AREA?
BHI 1$ ;NO, CONTINUE.
.ENDC
.IF NDF NOTRAK
MOV #DJMP,$CTRAK ;BYPASS TRACK OBJECT
CLR $TRAKC ;CLEAR COMPLETION ADDR
.ENDC
.IF NDF NONAME
CLR $NRBUF ;CLEAR NAME STACK BUFR PTR
.ENDC
.IF NDF NOSTAT
CLR $TATBF ;CLEAR BUFFER POINTERS
CLR $LPBUF ;CLEAR LP BUFR PTR
.ENDC
CLR $NR ;CLEAR NAME REGISTER
CEXIT: MOV (SP)+,R1
BR STXIT
.SBTTL FILE DELETE SUBROUTINE
; $VFDEL -- UTILITY SUBROUTINE FOR INTERNAL USE.
; THIS SUBROUTINE DELETES A CALL TO A USER DISPLAY FILE
; BY REMOVING BOTH THE DJSR CALL AND THE FILE ADDRESS.
R1=%1
PC=%7
DJMP=160000
.GLOBL $VFDEL,$NULL
$VFDEL:
.IF NDF NOTAG
MOV #DJMP,(R1)+ ;REMOVE THE DJSR CALL
.ENDC
TST (R1)+ ;POINT TO FILE ADDR.
MOV #$NULL,(R1)+ ;AND NULL IT OUT
RTS PC
.SBTTL EXTERNAL DISPLAY STOP ROUTINE
; STOPS THE DISPLAY, RETURNS WHEN ACCOMPLISHED.
; SERVICES THE .STOP REQUEST. THE DPU IS ACTUALLY
; STOPPED ONLY WHEN NOLINK IS DEFINED. IN ALL OTHER
; CASES ALL USER FILES ARE BY-PASSED TO SIMULATEA
; STOP.
R2=%2
PC=%7
.GLOBL $VSTOP,$VSTIN,$VSTP
.IF NDF NOLINK
.GLOBL $NULL,$BYPAS
.ENDC
$VSTOP:
.IF NDF NOLINK
JSR PC,$VSTP ;STOP THE DISPLAY
MOV #$NULL,$BYPAS ;INSERT BYPASS OF USER
BR STXIT ;THEN START DPU & EXIT
.IFF
JMP $VSTP ;STOP DISPLAY
.ENDC
.SBTTL INSERT A FILE ROUTINE
; THIS ROUTINE INSERTS A USER DISPLAY FILE INTO THE DISPLAY
; LOOP BY INSERTING A SUBROUTINE CALL TO THE FILE. IF AN EMPTY
; SLOT IS NOT FOUND, THE REQUEST IS IGNORED AND C IS SET
DJSR=173400
R0=%0
R1=%1
SP=%6
PC=%7
.GLOBL $VNSRT,$NULL,$VSTP,$VSTIN
.IF NDF NOUSER
.GLOBL $VSRCH
.ENDC
$VNSRT: MOV R1,-(SP)
.IF DF NOTAG
JSR PC,$VSTP ;STOP DPU FIRST
.ENDC
.IF DF NOUSER
MOV #$CUSER,R1 ;POINT TO USER CALL
MOV R0,-(SP) ;PUSH ADDR ON STACK
.IFF
JSR PC,$VSRCH ;SEE IF ALREADY THERE.
TST R1 ;R1 RETURNS NON-ZERO IF
BNE CENBL ;ALREADY IN ROOT.
MOV R0,-(SP) ;SAVE FILE ADDR. TEMP.
MOV #$NULL,R0 ;NOT THERE SO FIND EMPTY
JSR PC,$VSRCH ;SLOT TO PUT IT IN.
TST R1 ;FOUND A SLOT?
BEQ IEXIT ;NO, SEND MESG.
.ENDC
.IF NDF NOTAG
MOV (SP)+,4(R1) ;YES, INSERT FILE ADDR.
.IFF
MOV (SP)+,2(R1) ;INSERT FILE ADDR.
.ENDC
CENBL: MOV #DJSR,(R1) ;THEN A CALL.
IEXIT:
MOV (SP)+,R1
.IF DF NOTAG
BR STXIT ;START DPU & EXIT
.IFF
RTS PC
.ENDC
.SBTTL REMOVE A FILE ROUTINE
; THIS ROUTINE REMOVES THE CALL TO A USER DISPLAY FILE FROM
; THE ROOT FILE. IT CAN NOT LATER BE RECOVERED.
R1=%1
SP=%6
PC=%7
.GLOBL $VRMOV,$VFDEL,$VSTP
.IF NDF NOUSER
.GLOBL $VSRCH
.ENDC
$VRMOV: MOV R1,-(SP)
.IF DF NOTAG
JSR PC,$VSTP ;STOP DISPLAY FIRST
.ENDC
.IF DF NOUSER
MOV #$CUSER,R1 ;POINT R1 TO CALL
.IFF
JSR PC,$VSRCH ;SEARCH FOR CALL TO FILE.
TST R1 ;R1 WILL BE ZERO IF IT
BEQ IEXIT ;WASN'T FOUND.
.ENDC
JSR PC,$VFDEL ;FOUND, SO DELETE IT
BR IEXIT
.SBTTL DISPLAY START ROUTINE
; THIS ROUTINE CAUSES THE DISPLAY PROCESSOR TO START OPERATION.
PC=%7
.IF NDF NOLINK
.GLOBL $CTRAK,$BYPAS
.ENDC
.GLOBL $VSTRT,$VSTIN
$VSTRT:
.IF NDF NOLINK
JSR PC,$VSTP ;STOP DISPLAY
MOV #$CTRAK,$BYPAS ;REMOVE BYPASS
.ENDC
STXIT: JMP $VSTIN ;INIT STACK AND START
.END
.TITLE VTCAL2 V02-03
;
; VTCALL, A LIBRARY OF SUBROUTINES TO
; SUPPORT THE VT11 DISPLAY PROCESSOR
;
; DEC-11-OVTHA-E
;
; COPYRIGHT (C) 1974,1975
;
; DIGITAL EQUIPMENT CORPORATION
; MAYNARD, MASSACHUSETTS 01754
;
; THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY
; ON A SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH
; THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS
; SOFTWARE, OR ANY OTHER COPIES THEREOF, MAY NOT BE PROVIDED
; OR OTHERWISE MADE AVAILABLE TO ANY OTHER PERSON EXCEPT
; FOR USE ON SUCH SYSTEM AND TO ONE WHO AGREES TO THESE
; LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE SOFTWARE
; SHALL AT ALL TIMES REMAIN IN DIGITAL.
;
; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO
; CHANGE WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED
; AS A COMMITMENT BY DIGITAL EQUIPMENT CORPORATION.
; DIGITAL ASSUMES NO RESPONSIBILITY FOR ANY ERRORS THAT
; MAY APPEAR IN THIS DOCUMENT
;
; DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE
; OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT
; WHICH IS NOT SUPPLIED BY DIGITAL.
;
; MARCH 1974
;
; D. VELTEN
;
; VERSION 02
;
; EDIT 3 ;
; THE DISPLAY FILE HANDLER IS CONDITIONALIZED SO THAT IT
; MAY BE EASILY ADAPTED TO A VARIETY OF APPLICATIONS. IF NO
; CONDITIONS ARE SPECIFIED, THE HANDLER WILL HAVE THESE
; CHARACTERISTICS:
;
; - DISPLAY STOP AND LIGHT PEN INTERRUPT HANDLERS
; - SUBPICTURE STACK DEPTH OF 10
; - NAME REGISTER STACK DEPTH OF 10
; - MAXIMUM OF 2 USER MAIN DISPLAY FILES
; - RT11 SCROLLER LINK-UP CAPABILITY
; - TRACKING OBJECT
; - BASIC/GT-FORTRAN/GT FILE COMPATIBILITY
; - SUBROUTINE CALL SEQUENCE WILL BE:
; DJSR
; RETURN ADDR.
; SUBR. ADDR.
; TAG
;
; TO ALTER THE HANDLER DEFAULT STRUCTURE:
;
; DEFINE: RESULT:
;
; NOLINK CREATES STAND ALONE SYSTEM W/O SCROLL
; LINK. CALL .SCROL IS UNDEFINED.
;
; NOTRAK NO TRACK OBJECT. IMPLIED WHEN NOTAG OR
; NOLPEN ARE DEFINED.
;
; NOTAG NO BASIC/GT TAG STRUCTURE. CALLS .BLANK,
; .RESTR,.TRACK ARE UNDEFINED. CALL SEQ. IS:
; DJSR
; ADDR. OF SUBR.
;
; NOLPEN NO LIGHT PEN SUPPORT, .LPEN UNDEFINED
;
; NOSTAT NO STATUS DATA SUPPORT, .STAT UNDEFINED.
;
; NOUSER ONLY A SINGLE USER DISPLAY FILE MAY
; BE INSERTED AT AT TIME.
;
; NONAME NO NAME REGISTER STACK.
;
; NORT11 RT11 MONITOR DEPENDENCIES ARE REMOVED.
; NOLINK IS IMPLIED AND .SCROL IS UNDEFINED.
;
; TO ALTER HANDLER DEFAULT PARAMETERS:
;
; DEFINE: DEFAULT(OCTAL): MEANING:
;
; SCRPOS 1750 SCROLL TOP Y POSITION
;
; STKSIZ 12 SUBPICTURE STACK DEPTH
;
; USERNM 2 MAX. # USER MAIN FILES
; THAT CAN BE CALLED BY HANDLR
;
; THE FOLLOWING ARE DISPLACEMENTS OF PARAMETERS WITHIN THE
; SCROLL LOGIC LOCATED ABOVE THE RMON FROM THE BEGINNING OF
; THE SCROLL LOGIC. THEY MUST BE REDEFINED IF THEIR POSITION
; CHANGES.
;
; TAG: DEFAULT USE
;
; SCLINK 6 SCROLL LINK SEGMENT
;
; SCMAX 4 MAX. LINE COUNT
;
; DISP 300 DISPL. FROM RMON (LOC. 54)
; TO CONFIG WD.
;
; THE VT11 HAS FLOATING VECTORS. IF THE VT11 IS INSTALLED AT
; A VECTOR OR DEVICE ADDRESS OTHER THAN DEFAULT, THESE
; PARAMETERS SHOULD BE REDEFINED:
;
; DEFINE: DEFAULT: MEANING:
;
; FVEC 320 DISPLAY STOP INT. TRAP ADDR.
;
; DPC 172000 FIRST DEVICE ADDR. (DISPLAY
; PROGRAM COUNTER).
;
.IF NDF NOTAG
.SBTTL BLANK A FILE ROUTINE
; THIS ROUTINE BYPASSES THE CALL TO A USER DISPLAY FILE BUT
; DOES NOT REMOVE THE FILE ADDRESS. THE FILE CAN LATER BE
; UNBLANKED BY A CALL TO RESTR.
DJMP=160000
R1=%1
SP=%6
PC=%7
.CSECT $GT2
.GLOBL $VBLNK,$VSTIN,$VSTP,$CUSER
.IF NDF NOUSER
.GLOBL $VSRCH
.ENDC
$VBLNK: MOV R1,-(SP)
.IF DF NOUSER
MOV #$CUSER,R1 ;POINT TO FILE
.IFF
JSR PC,$VSRCH ;SEARCH FOR CALL TO FILE
TST R1 ;R1 WILL BE ZERO IF IT
BEQ REXIT ;WAS NOT FOUND.
.ENDC
JSR PC,$VSTP ;STOP DISPLAY
MOV #DJMP,(R1) ;BYPASS THE FILE
MOV (SP)+,R1
JMP $VSTIN ;RESTART DSIPLAY
.ENDC
.IF NDF NOTAG
.SBTTL RESTORE A FILE ROUTINE
; $VRSTR -- SERVICES THE .RESTR USER REQUEST.
; THIS ROUTINE RESTORES THE CALL TO A USER DISPLAY FILE THAT
; WAS PREVIOUSLY BLANKED.
DJSR=173400
R0=%0
R1=%1
R5=%5
SP=%6
PC=%7
.GLOBL $VRSTR,$CUSER
.IF NDF NOUSER
.GLOBL $VSRCH
.ENDC
$VRSTR: MOV R1,-(SP)
.IF DF NOUSER
MOV #$CUSER,R1 ;POINT TO FILE
.IFF
JSR PC,$VSRCH ;LOOK FOR FILE.
TST R1 ;R1 WILL BE ZERO IF
BEQ REXIT ;FILE NOT FOUND.
.ENDC
MOV #DJSR,(R1) ;INSERT A CALL TO FILE
REXIT: MOV (SP)+,R1
RTS PC
.ENDC
.IF NDF NOUSER
.SBTTL SEARCH FOR FILE SUBROUTINE
; $VSRCH -- UTILITY SUBROUTINE FOR INTERNAL USE.
; IT SEARCHES THE ROOT FILE FOR THE CALL TO A USER
; FILE WHOSE ADDRESS IS PASSED IN R0. THE ADDRESS OF THE CALL
; IS RETURNED IN R1 IF FOUND, OTHERWISE R1 IS ZEROED.
R0=%0
R1=%1
PC=%7
.GLOBL $VSRCH,$CUSER,$NULL
$VSRCH: MOV #$CUSER,R1 ;GET START OF USER CALL AREA
.IF NDF NOTAG
1$: CMP R0,4(R1) ;COMPARE ADDRESSES.
.IFF
1$: CMP R0,2(R1) ;COMPARE ADDRESSES
.ENDC
BEQ 2$ ;ARE THEY THE SAME?
.IF NDF NOTAG
ADD #6,R1 ;GO TO NEXT CALL
.IFF
CMPB (R1)+,(R1)+
.ENDC
CMP #$NULL,R1 ;PAST THE END?
BHI 1$ ;NO, CONTINUE SEARCH.
CLR R1 ;YES, CLEAR R1
2$: RTS PC
.ENDC
.END
.TITLE VTCAL3 V02-04
;
; VTCALL, A LIBRARY OF SUBROUTINES TO
; SUPPORT THE VT11 DISPLAY PROCESSOR
;
; DEC-11-OVTHA-E
;
; COPYRIGHT (C) 1974,1975
;
; DIGITAL EQUIPMENT CORPORATION
; MAYNARD, MASSACHUSETTS 01754
;
; THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY
; ON A SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH
; THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS
; SOFTWARE, OR ANY OTHER COPIES THEREOF, MAY NOT BE PROVIDED
; OR OTHERWISE MADE AVAILABLE TO ANY OTHER PERSON EXCEPT
; FOR USE ON SUCH SYSTEM AND TO ONE WHO AGREES TO THESE
; LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE SOFTWARE
; SHALL AT ALL TIMES REMAIN IN DIGITAL.
;
; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO
; CHANGE WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED
; AS A COMMITMENT BY DIGITAL EQUIPMENT CORPORATION.
; DIGITAL ASSUMES NO RESPONSIBILITY FOR ANY ERRORS THAT
; MAY APPEAR IN THIS DOCUMENT
;
; DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE
; OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT
; WHICH IS NOT SUPPLIED BY DIGITAL.
;
; MARCH 1974
;
; D. VELTEN
;
; VERSION 02
;
; EDIT 4 ;
; THE DISPLAY FILE HANDLER IS CONDITIONALIZED SO THAT IT
; MAY BE EASILY ADAPTED TO A VARIETY OF APPLICATIONS. IF NO
; CONDITIONS ARE SPECIFIED, THE HANDLER WILL HAVE THESE
; CHARACTERISTICS:
;
; - DISPLAY STOP AND LIGHT PEN INTERRUPT HANDLERS
; - SUBPICTURE STACK DEPTH OF 10
; - NAME REGISTER STACK DEPTH OF 10
; - MAXIMUM OF 2 USER MAIN DISPLAY FILES
; - RT11 SCROLLER LINK-UP CAPABILITY
; - TRACKING OBJECT
; - BASIC/GT-FORTRAN/GT FILE COMPATIBILITY
; - SUBROUTINE CALL SEQUENCE WILL BE:
; DJSR
; RETURN ADDR.
; SUBR. ADDR.
; TAG
; TO ALTER THE HANDLER DEFAULT STRUCTURE:
;
; DEFINE: RESULT:
;
; NOLINK CREATES STAND ALONE SYSTEM W/O SCROLL
; LINK. CALL .SCROL IS UNDEFINED.
;
; NOTRAK NO TRACK OBJECT. IMPLIED WHEN NOTAG OR
; NOLPEN ARE DEFINED.
;
; NOTAG NO BASIC/GT TAG STRUCTURE. CALLS .BLANK,
; .RESTR,.TRACK ARE UNDEFINED. CALL SEQ. IS:
; DJSR
; ADDR. OF SUBR.
;
; NOLPEN NO LIGHT PEN SUPPORT, .LPEN UNDEFINED
;
; NOSTAT NO STATUS DATA SUPPORT, .STAT UNDEFINED.
;
; NOUSER ONLY A SINGLE USER DISPLAY FILE MAY
; BE INSERTED AT AT TIME.
;
; NONAME NO NAME REGISTER STACK.
;
; NORT11 RT11 MONITOR DEPENDENCIES ARE REMOVED.
; NOLINK IS IMPLIED AND .SCROL IS UNDEFINED.
;
; TO ALTER HANDLER DEFAULT PARAMETERS:
;
; DEFINE: DEFAULT(OCTAL): MEANING:
;
; SCRPOS 1750 SCROLL TOP Y POSITION
;
; STKSIZ 12 SUBPICTURE STACK DEPTH
;
; USERNM 2 MAX. # USER MAIN FILES
; THAT CAN BE CALLED BY HANDLR
;
; THE FOLLOWING ARE DISPLACEMENTS OF PARAMETERS WITHIN THE
; SCROLL LOGIC LOCATED ABOVE THE RMON FROM THE BEGINNING OF
; THE SCROLL LOGIC. THEY MUST BE REDEFINED IF THEIR POSITION
; CHANGES.
;
; TAG: DEFAULT USE
;
; SCLINK 6 SCROLL LINK SEGMENT
;
; SCMAX 4 MAX. LINE COUNT
;
; DISP 300 DISPL. FROM RMON (LOC. 54)
; TO CONFIG WD.
;
; THE VT11 HAS FLOATING VECTORS. IF THE VT11 IS INSTALLED AT
; A VECTOR OR DEVICE ADDRESS OTHER THAN DEFAULT, THESE
; PARAMETERS SHOULD BE REDEFINED:
;
; DEFINE: DEFAULT: MEANING:
;
; FVEC 320 DISPLAY STOP INT. TRAP ADDR.
;
; DPC 172000 FIRST DEVICE ADDR. (DISPLAY
; PROGRAM COUNTER).
.IF NDF NOTRAK
.SBTTL TRACKING OBJECT ROUTINE
; THIS ROUTINE ENABLES THE TRACKING OBJECT AND SETS UP
; POINTERS TO LOCATIONS WHERE AN INITIAL X AND Y POSITION
; ARE LOCATED. THESE ARE INSERTED INTO THE DISPLAY FILE.
; AS THE OBJECT MOVES, SUBSEQUENT VALUES OF X AND Y ARE
; RETURNED IN THE SAME LOCATIONS.
R0=%0
SP=%6
PC=%7
DJSR=173400
DJMP=160000
.CSECT $GT3
.GLOBL $VTRAK,$XT,$YT,$XSTOR,$YSTOR,$CTRAK,$TRAKC
$VTRAK: TST R0 ;NULL CALL?
BNE 1$ ;NO
MOV #DJMP,$CTRAK ;YES,DISABLE TRACK OBJ.
CLR $TRAKC ;CLEAR COMPL. ROUT. ADDR.
BR 2$
1$: MOV R0,$XSTOR ;SAVE ADDR OF X VALUE
MOV (R0)+,$XT ;TRANSFER THE X VALUE
MOV R0,$YSTOR ;SAVE ADDR OF Y VALUE
MOV (R0),$YT ;TRANSFER Y VALUE
MOV #DJSR,$CTRAK ;ENABLE THE TRACK OBJECT
MOV 2(SP),$TRAKC ;SET UP COMPL. ROUT ADDR
2$: MOV (SP)+,(SP) ;CLEAR OUT STACK
RTS PC
.ENDC
.IF NDF NOLPEN
.SBTTL LIGHT PEN SETUP ROUTINE
; THIS ROUTINE SETS UP A POINTER TO A USER BUFFER AREA WHERE
; STATUS DATA WILL BE RETURNED ON LP HITS. THE FIRST
; LOCATION OF THE BUFFER IS TREATED AS A FLAG AND WILL BE
; SET TO ONE WHEN A HIT OCCURS AND DATA IS TRANSFERRED. NO
; MORE DATA WILL BE XFERED UNTIL THE USER CLEARS THE FLAG.
; THIS ROUTINE INITIALLY CLEARS THE FLAG.
; STATUS DATA XFERED IS: NAME REGISTER,SUBPICTURE TAG,DPC,DSR,
; XSR,YSR.
R0=%0
PC=%7
.GLOBL $VLPEN,$LPBUF
$VLPEN: MOV R0,$LPBUF ;STORE USER BUFFER ADDR.
CLR (R0) ;INITIALLY CLEAR FLAG
RTS PC
.ENDC
.IF NDF NOSTAT
.SBTTL STATUS BUFFER SETUP ROUTINE
;
; THIS ROUTINE SETS UP APOINTER TO A USER BUFFER AREA WHERE
; STATUS DATA WILL BE TRANSFERRED ON RECEIPT OF A DHALT
; OR DSTAT. THE SAME BUFFER STRUCTURE AND
; STATUS DATA DESCRIBED FOR THE LIGHT PEN ROUTINE APPLY
; HERE. THE DISPLAY IS LEFT STOPPED. THE USER MUST DETECT THE
; FLAG AND ISSUE A RESUME.
;
R0=%0
PC=%7
.GLOBL $VSTPM,$TATBF
$VSTPM: MOV R0,$TATBF ;SAVE THE STATUS BUFFER AREA
CLR (R0) ;CLEAR THE FLAG INITIALLY
RTS PC
.ENDC
.SBTTL POWER LINE SYNC ROUTINE
; THIS ROUTINE HAS TWO ENTRY POINTS. IT IS USED TO ENABLE
; AND DISABLE POWER LINE SYNC IN THE VT11 PROCESSOR.
; INTERNAL GLOBALS
.GLOBL $SYNC,$NOSYN
; EXTERNAL GLOBALS
.GLOBL $LSRA
PC=%7
$NOSYN: MOV #170240,$LSRA ;TURN SYNC OFF
RTS PC
$SYNC: MOV #170244,$LSRA ;TURN SYNC ON
RTS PC
.IF NDF NONAME
.SBTTL NAME REGISTER STACK RETURN ROUTINE
; THIS ROUTINE SETS UP A POINTER TO THE BUFFER WHERE THE
; NAME REGISTER STACK CONTENTS WILL BE RETURNED ON A LIGHT
; PEN INTERRUPT. THE BUFFER SIZE MUST BE STACK SIZE (RETURNED
; IN R0 BY .LNKRT) PLUS ONE. THE FIRST BYTE WILL HAVE THE
; STACK DEPTH AND THE SECOND BYTE WILL BE NON-ZERO TO FLAG
; RETURN OF THE DATA. NO FURTHER TRANSFERS WILL BE MADE UNTIL
; THIS FLAG IS CLEARED (IT IS CLEARED INITIALLY BY THE CALL
; TO .NAME.
R0=%0
PC=%7
.GLOBL $NAME ;INTERNAL GLOBAL
.GLOBL $NRBUF ;EXTERNAL GLOBAL
$NAME: MOV R0,$NRBUF ;SAVE PTR TO BUFR
CLR @R0 ;CLEAR FLAG
RTS PC
.ENDC
.END
.SBTTL POWER LINE SYNC CONTROL
; THESE CALLS PERMIT THE GRAPHICS USER TO SYNCHRONIZE THE
; DISPLAY FILE WITH THE POWER LINE FREQUENCY. THE DPU STOPS
; AND THEN RESUMES WHEN THE POWER LINE CROSSES A DETECTION POINT.
.GLOBL $SYNC,$NOSYN,$LSRA
$SYNC: BIS #4,$LSRA ;SET SYNC STOP BIT
RTS PC
$NOSYN: BIC #4,$LSRA ;CLAER SYNC STOP BIT
RTS PC
.IF NDF NONAME
.SBTTL NAME REGISTER STACK BUFFER SETUP ROUTINE
; THIS ROUTINE ENABLES RETURN OF THE NAME REGISTER STACK
; AFTER A LIGHT PEN HIT. THE NAME REGISTER AT THE TIME OF
; A DISPLAY SUBROUTINE CALL IS PUSHED ON THE NR STACK. WHEN
; A LIGHT PEN HIT OCCURS, THE RETURN OF THE NR STACK
; PERMITS TRACING THE SEQUENCE OF CALLS LEADING TO THE IMAGE
; WHICH WAS SELECTED BY THE LIGHT PEN.
.GLOBL $NRBUF,$NAME
$NAME: MOV R0,$NRBUF ;SAVE PTR TO BUFFER
RTS PC
.TITLE VTCAL4 V02-09
; VTCALL, A LIBRARY OF SUBROUTINES TO
; SUPPORT THE VT11 DISPLAY PROCESSOR
; DEC-11-OVTHA-E
; COPYRIGHT (C) 1974,1975
; DIGITAL EQUIPMENT CORPORATION
; MAYNARD, MASSACHUSETTS 01754
; THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY
; ON A SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH
; THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS
; SOFTWARE, OR ANY OTHER COPIES THEREOF, MAY NOT BE PROVIDED
; OR OTHERWISE MADE AVAILABLE TO ANY OTHER PERSON EXCEPT
; FOR USE ON SUCH SYSTEM AND TO ONE WHO AGREES TO THESE
; LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE SOFTWARE
; SHALL AT ALL TIMES REMAIN IN DIGITAL.
;
; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO
; CHANGE WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED
; AS A COMMITMENT BY DIGITAL EQUIPMENT CORPORATION.
; DEC ASSUMES NO RESPONSIBILITY FOR ANY ERRORS THAT
; MAY APPEAR IN THIS DOCUMENT
; DEC ASSUMES NO RESPONSIBILITY FOR THE USE
; OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT
; WHICH IS NOT SUPPLIED BY DEC.
; MARCH 1974
; D. VELTEN
; VERSION 02C
; EDIT 8
; THE DISPLAY FILE HANDLER IS CONDITIONALIZED SO THAT IT
; MAY BE EASILY ADAPTED TO A VARIETY OF APPLICATIONS. IF NO
; CONDITIONS ARE SPECIFIED, THE HANDLER WILL HAVE THESE
; CHARACTERISTICS:
;
; - DISPLAY STOP AND LIGHT PEN INTERRUPT HANDLERS
; - SUBPICTURE STACK DEPTH OF 10
; - NAME REGISTER STACK DEPTH OF 10
; - MAXIMUM OF 2 USER MAIN DISPLAY FILES
; - RT11 SCROLLER LINK-UP CAPABILITY
; - TRACKING OBJECT
; - BASIC/GT-FORTRAN/GT FILE COMPATIBILITY
; - SUBROUTINE CALL SEQUENCE WILL BE:
; DJSR
; RETURN ADDR.
; SUBR. ADDR.
; TAG
;
; TO ALTER THE HANDLER DEFAULT STRUCTURE:
;
; DEFINE: RESULT:
;
; NOLINK CREATES STAND ALONE SYSTEM W/O SCROLL
; LINK. CALL .SCROL IS UNDEFINED.
;
; NOTRAK NO TRACK OBJECT. IMPLIED WHEN NOTAG OR
; NOLPEN ARE DEFINED.
;
; NOTAG NO BASIC/GT TAG STRUCTURE. CALLS .BLANK,
; .RESTR,.TRACK ARE UNDEFINED. CALL SEQ. IS:
; DJSR
; ADDR. OF SUBR.
;
; NOLPEN NO LIGHT PEN SUPPORT, .LPEN UNDEFINED
;
; NOSTAT NO STATUS DATA SUPPORT, .STAT UNDEFINED.
;
; NOUSER ONLY A SINGLE USER DISPLAY FILE MAY
; BE INSERTED AT AT TIME.
;
; NONAME NO NAME REGISTER STACK.
;
; NORT11 RT11 MONITOR DEPENDENCIES ARE REMOVED.
; NOLINK IS IMPLIED AND .SCROL IS UNDEFINED.
;
; TO ALTER HANDLER DEFAULT PARAMETERS:
;
; DEFINE: DEFAULT(OCTAL): MEANING:
;
; SCRPOS 1350 SCROLL TOP Y POSITION
;
; STKSIZ 12 SUBPICTURE STACK DEPTH
;
; USERNM 5 MAX. # USER MAIN FILES
; THAT CAN BE CALLED BY HANDLR
;
; THE FOLLOWING ARE DISPLACEMENTS OF PARAMETERS WITHIN THE
; SCROLL LOGIC LOCATED ABOVE THE RMON FROM THE BEGINNING OF
; THE SCROLL LOGIC. THEY MUST BE REDEFINED IF THEIR POSITION
; CHANGES.
;
; TAG: DEFAULT USE
;
; SCLINK 6 SCROLL LINK SEGMENT
;
; SCMAX 4 MAX. LINE COUNT
;
; RMDISP 5000 DISPL. FROM RMON (LOC. 54)
; TO SCROLL LOGIC.
;
; THE VT11 HAS FLOATING VECTORS. IF THE VT11 IS INSTALLED AT
; A VECTOR OR DEVICE ADDRESS OTHER THAN DEFAULT, THESE
; PARAMETERS SHOULD BE REDEFINED:
;
; DEFINE: DEFAULT: MEANING:
;
; FVEC 320 DISPLAY STOP INT. TRAP ADDR.
;
; DPC 172000 FIRST DEVICE ADDR. (DISPLAY
; PROGRAM COUNTER).
.IF DF NORT11
NOLINK=1
.ENDC
.CSECT $GT4
.SBTTL SCROLLER LINK UP ROUTINE
; $VRTLK -- SERVICES THE .LNKRT USER REQUEST.
; THIS ROUTINE LINKS THE HANDLER'S INTERNAL DISPLAY FILE
; INTO THE SCROLLER DPU LOOP, FORMING A SINGLE LOOP. IT
; CHECKS TO SEE IF THE SCROLLER EXISTS, AND JUST EXITS WITH
; THE DISPLAY RUNNING AND C SET IF IT DOESN'T.
R0=%0
R1=%1
R2=%2
SP=%6
PC=%7
DJMP=160000
; THE FOLLOWING CONDITIONALS ARE DISPLACEMENTS FROM THE
; BEGINNING OF THE SCROLLER CODE FOR IMPORTANT
; LOCATIONS WITHIN THE SCROLLER. IF THEIR LOCATIONS
; WITHIN THE SCROLLER CHANGE, THESE CONDITIONAL ASSIGNMENTS
; MUST BE CHANGED.
.IIF NDF SCLINK,SCLINK=6 ;SCROLL LINK SEGMENT
.IIF NDF SCMAX,SCMAX=4 ;MAX. LINE COUNT
.IF NDF NORT11
.MCALL ..V2..,.DEVICE,.PROTECT
..V2..
PRI=340 ;INTERRUPT PRIORITY 7
.IFF
PRI=200 ;INTERRUPT PRIORITY 7
.ENDC
; INTERNAL GLOBALS
.GLOBL $VRTLK
; EXTERNAL GLOBALS
.IF NDF NOLINK
.GLOBL $LINKF,$LCDIS,$LINK,$LCNT,$VLSET
.ENDC
.GLOBL $DSVEC,$LPINT,$SOINT,STKSIZ,$DSINT
.GLOBL $DPC,$DFILE
.IF NDF NORT11
.GLOBL $PEXIT,$PDV1
.ENDC
$VRTLK:
.IF NDF NOLINK
MOV #-3,R0 ;PRESET ERROR CODE
TST $LINKF ;LINK ALREADY MADE?
BNE 4$ ;YES, EXIT
.IFTF
MOV R1,-(SP)
.IFT
JSR PC,$VLSET ;GET SCROLLER POSITION
BCS 3$ ;BAD ERROR
MOV R1,-(SP) ;SAVE POINTER TO SCROLLER
.ENDC
MOV $DSVEC,R1 ;POINT TO STOP VECTOR
.IF NDF NORT11
MOV R1,$PDV1 ;SET UP SPECIAL DEVICE TABLE
MOV #$PEXIT,$PDV1+2 ;INSERT SPECIAL EXIT ADDR
.DEVICE #EMTS,#$PDV1 ;THEN PASS TO MONITOR
.PROTECT #EMTS,R1 ;PROTECT FIRST VECTOR PAIR
.ENDC
MOV #$DSINT,(R1)+ ;SETUP STOP INTER.
MOV #PRI,(R1)+ ;AND PRIORITY
.IF NDF NORT11
.PROTECT #EMTS,R1 ;PROTECT NEXT PAIR
.IFTF
MOV #$LPINT,(R1)+ ;SETUP LPEN INT.
MOV #PRI,(R1)+
.IF NDF NOLINK
TST (SP) ;SCROLLER IN CORE?
BNE 5$
.ENDC
.IFT
.PROTECT #EMTS,R1 ;PROTECT LAST PAIR
.IFTF
MOV #$SOINT,(R1)+ ;NO, SET UP S.O. INT
MOV #PRI,(R1)
.ENDC
1$:
.IF NDF NOLINK
TST (SP)+ ;POP SCROLLER ADDR OFF STACK
.IFTF
MOV #$DFILE,@$DPC ;START DISPLAY
.IFT
SEC ;FLAG NO SCROLLER
BR 2$ ;THEN SKIP THE LINK UP
5$:
MOV (SP)+,R1 ;RESTORE SCROLLER ADR TO R1
INC $LINKF ;SET THE LINK UP FLAG
MOV SCLINK+2(R1),$LINK ;SAVE SCROLL LINK ADDR.
MOV #$LINK+2,SCLINK+2(R1) ;THEN LINK TO HANDLER
ADD #SCMAX,R1 ;COMPUTE LINE COUNT ADDR.
MOV R1,$LCDIS ;AND SAVE IT.
MOV (R1),$LCNT ;ALSO SAVE THE COUNT
.ENDC
CLC
2$: MOV #STKSIZ,R0 ;RETURN STACK SIZE IN R0
3$: MOV (SP)+,R1 ;WAS SAVED BY $VLSET
4$: MOV R0,R0 ;SET CONDITION BITS; C THE SAME
RTS PC
.IF NDF NORT11
EMTS: .BLKW 2
.ENDC
.SBTTL SCROLLER DE-LINK ROUTINE
; $VUNLK -- SERVICES THE .UNLNK USER REQUEST.
; THIS ROUTINE DELINKS THE HANDLER'S INTERNAL DISPLAY
; FILE FROM THE SCROLLER SITUATED ABOVE THE RT11 RMON.
; IF NO LINK EXISTS IT SIMPLY EXITS WITH THE DISPLAY
; PROCESSOR STOPPED.
R1=%1
SP=%6
PC=%7
; THE FOLLOWING CONDITIONALS ARE DISPLACEMENTS FROM THE
; BEGINNING OF THE SCROLLER CODE. IF THEIR LOCATION WITHIN THE
; THE SCROLLER CHANGES, THESE ASSIGNMENTS MUST BE CHANGED.
; INTERNAL GLOBALS
.GLOBL $VUNLK
; EXTERNAL GLOBALS
.IF NDF NOLINK
.GLOBL $VLSET,$LCDIS
.GLOBL $LINKF,$LINK,$LCNT
.ENDC
.GLOBL $VSTP,$DSVEC,$DPC
$VUNLK: MOV R1,-(SP)
MOV @#54,R1 ;R1 -> RMON ;DV
BIT #HWDSP$,DISP(R1) ;IS A VT11 PRESENT? ;DV
BEQ XIT1 ;NO, THIS IS A NOP ;DV
TST @$DSVEC ;IS THIS A START OR RESTART?
BEQ 4$ ;YES,DON'T TRY TO STOP
JSR PC,$VSTP ;YES, STOP THE DISPLAY
.IF NDF NOLINK
TST $LINKF ;LINK EXISTS?
BNE 1$
.IFTF
4$:
.IFT
INC $LINKF ;NO=>NO SCROLLER
JSR PC,$VLSET ;BUT FAKE IT ANYWAY
BR 2$ ;THEN JUST EXIT
1$: JSR PC,$VLSET ;GET SCROLL ADDR IF ANY
BCS XIT1 ;ERROR CODE IN R0
BEQ 2$ ;NO SCROLLER, NO LINK
MOV $LINK,-(SP) ;GET LINK TO SCROLL
MOV (SP),SCLINK+2(R1) ;REMOVE LINK TO US
MOV $LCNT,@$LCDIS ;RESTORE RMON'S LINE CNT
CLR $PDV1+2 ;AND SPECIAL EXIT ADDR
MOV (SP)+,@$DPC ;THEN START DPU THERE
2$: CLR $LINKF ;CLEAR THE LINK UP FLAG
.ENDC
3$: CLR @$DSVEC ;CLEAR THE VECTOR
BR XIT1
.IF NDF NOLINK
.SBTTL LINK SET UP SUBROUTINE
; THIS SUBROUTINE SETS UP R1 TO POINT TO THE BOTTOM OF THE
; SCROLLER CODE LOCATED ABOVE RMON. R1 IS ASSUMED TO
; BE STACKED AND IS SET TO POINT TO BOTTOM OF SCROLLER.
R1=%1
SP=%6
PC=%7
HWDSP$=4 ;VT11 HARDWARE PRESENT
GTLNK$=400 ;VT11 IN USE
.IIF NDF DISP,DISP=300 ;DISP TO CONFIG WORD IN RMON
.IIF NDF GTVECT,GTVECT=354 ;DISP TO VT11 VECTOR IN RMON
$VLSET: CLR R0
MOV @#54,R1 ;GET BOTTOM OF RMON
MOV GTVECT(R1),$DSVEC ;FETCH DISPLAY VECTOR FROM RMON
ADD #DISP,R1 ;ADD DISP TO CONFIG WD.
BIT #HWDSP$,@R1 ;VT11 HARDWARE PRESENT?
BEQ 4$ ;NO, FATAL ERROR
TST $LINKF ;IS THIS AN UNLINK?
BNE 1$ ;YES,SKIP THIS
BIT #1,@R1 ;S/U MONITOR?
BEQ 2$ ;YES, CAN'T BE TWO USERS
TST 2(R1) ;SCROLLER IN CORE?
BEQ 2$ ;NO, SKIP IT, WON'T MATTER
BIT #GTLNK$,@R1 ;VT11 ALREADY IN USE?
BNE 3$ ;YES, GIVE AN ERROR
BIS #GTLNK$,@R1 ;NO, GRAB IT FOR US
BR 2$
1$: BIC #GTLNK$,@R1 ;CLEAR LINK UP FLAG
2$: CLC
MOV 2(R1),R1 ;GET SCROLLER ADDR.
RTS PC
3$: DEC R0 ;-2 ERROR RETURN
4$: DEC R0 ;-1 ERROR RETURN
SEC ;FLAG ERROR
RTS PC
.ENDC
.IF NDF NOLINK
.SBTTL SCROLLER PARAMETERS ROUTINE
; THIS ROUTINE ADJUSTS THE LINE COUNT AND STARTING POSITION
; PARAMETERS OF THE SCROLLER. IT EXPECTS THE ADDRESS OF A TABLE
; IN R0 CONTAINING THE DESIRED LINE COUNT AND POSITION.
; A ZERO VALUE IS TAKEN TO MEAN NO CHANGE FOR THAT PARAMETER.
R0=%0
SP=%6
PC=%7
CHAR=100000 ;CHARACTER MODE
INT0=2000 ;INTENSITY 0
INT4=3000 ;INTENSITY 4
; INTERNAL GLOBALS
.GLOBL $VSCRL
; EXTERNAL GLOBALS
.GLOBL $LCDIS,$YS,$LINKF
.GLOBL SCRPOS,$BLANK
.ENABL LSB
$VSCRL: TST $LINKF ;DOES LINK EXIST?
SEC
BEQ 10$ ;NO, JUST EXIT
MOV R1,-(SP)
MOVB (R0)+,R1 ;GET LINE COUNT
BEQ 3$ ;ZERO, SKIP IT
BPL 2$ ;MINUS => RESTORE DEFAULT
1$: MOV $LCNT,R1 ;RESTORE DEFAULT COUNT
2$: MOV R1,@$LCDIS ;TRANSFER LINE CT. TO SCROLL
3$: MOVB (R0)+,R1 ;GET SCROLL INTENSITY
BEQ 6$ ;YES, NO ACTION
BMI 4$ ;MINUS => RESTORE DEFAULT
DEC R1 ;SUB 1 TO GET 0-7
SWAB R1 ;POSITION INTENSITY BITS
ROR R1
ADD #CHAR!INT0,R1 ;CREATE AN INSTRUCTION
BR 5$
4$: MOV #CHAR!INT4,R1 ;TURN IT OFF
5$: MOV R1,$BLANK ;UNBLANK SCROLLER
6$: MOV (R0),R1 ;GET SCROLL POSITION
BEQ 9$ ;ZERO, SKIP IT
BPL 8$ ;MINUS => DEFAULT RESTORE
MOV #SCRPOS,R1 ;RESTORE MON DEFAULT
8$: MOV R1,$YS ;INSERT IN HANDLER
9$: CLC
.ENDC
XIT1: MOV (SP)+,R1
10$: RTS PC
.DSABL LSB
.END
.TITLE RT-11 BATCH V01-03
; RT-11 BATCH COMPILER
; MARCH, 1975
; JD/DV
; COPYRIGHT (C) 1975
; DIGITAL EQUIPMENT CORPORATION
; MAYNARD, MASSACHUSETTS 01754
; THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY
; ON A SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH
; THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS
; SOFTWARE, OR ANY OTHER COPIES THEREOF, MAY NOT BE PROVIDED
; OR OTHERWISE MADE AVAILABLE TO ANY OTHER PERSON EXCEPT
; FOR USE ON SUCH SYSTEM AND TO ONE WHO AGREES TO THESE
; LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE SOFTWARE
; SHALL AT ALL TIMES REMAIN IN DIGITAL.
; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO
; CHANGE WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED
; AS A COMMITMENT BY DIGITAL EQUIPMENT CORPORATION.
; DIGITAL ASSUMES NO RESPONSIBILITY FOR ANY ERRORS THAT
; MAY APPEAR IN THIS DOCUMENT
; DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE
; OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT
; WHICH IS NOT SUPPLIED BY DIGITAL.
.SBTTL SYMBOLS AND DEFINITIONS
;THE BATCH COMPILER HAS A HIGH SEG (PURE CODE) AND
;A LOW SEG (NOT SO PURE CODE)
;BATCH EXPECTS THAT R4 POINTS TO THE LOW SEG
;*******************************************************************
PIC= 0 ;SET TO 0 IF NO P.I.C. WANTED
;*******************************************************************
; ASCII CHARACTER DEFINITIONS
NL=12 ;NEW LINE;LINE FEED
FORM=14 ;FORM FEED
RET=15 ;RETURN;CARRIAGE RETURN
CTRL.Z=32 ;CONTROL Z;EOF
SPC=40 ;SPACE,BLANK
; RT-11 MONITOR DEFINITIONS
FBMON$ = 1
RONLY$ = 40000 ;DEVICE IS READ ONLY
SPECL$ = 10000 ;DEVICE IS NON-RT-11-DIRECTORIED.
BATBLK = 6 ;BLOCK 6 OF BA.SYS IS USED FOR BATCH STACK
JSW = 44
ERRWRD = 52 ;RT-11 ERROR WORD
SYSPTR = 54
$CSW = 4 ;OFFSET TO CHAN. 0
CONFIG = 300 ;OFFSET TO MONITOR CONFIGURATION WD
EMT16 = 316
CONTXT = 320
CHAIN = 400
CHNTXT = 510 ;PLACE WHERE TEXT CAN BE FOUND ON CHAIN (RT11)
; BATCH COMPILER DEFINITIONS
SAVNUM=10 ;# OF ARGS. SAVED ON BATCH STACK
;PER RECURSION OF THE COMPILER.
ARGLST= 13 ;NUMBER OF ARGUMENTS PASSED BETWEEN BATHND AND BATCH
BATSW1= ARGS ;POINTER TO BATSW1 LOC. IN BATCH HANDLER
SOURCE= 4 ;IF 1 GET A CHARACTER THROUGH
;THE BATCH HANDLER. IF 0 LET
;THE EMT GO TO THE MONITOR
BSOURC= 40000 ;IF 1 INPUT COMES FROM THE
;BATCH STREAM. IF 0 INPUT COMES
;FROM THE CTY:.
DESTON= 2 ;IF 1 OUTPUT TO BATCH
;IF 0 OUTPUT TO RMON.
BDESTN= 100 ;IF 1 BATCH LOG IS OUTPUT, IF 0 CTY: IS OUTPUT.
DATA= 40 ;IF 1 CHARACTERS FOLLOWING ARE
;USER DATA. IF 0 KMON.
ACTIVE= 20 ;CTY IS ACTIVE.
COMWAT= 10 ;A COMMAND IS WAITING
BEXIT= 100000 ;EXIT DURING DATA MODE
BGET= 200 ;"\G" MODE
HELP= 1 ; HELP MODE
INDATA = ARGS+2 ;POINTER TO INDATA
ODATA = ARGS+4 ;POINTER TO ODATA
OUTBUF = ARGS+6 ;POINTER TO BATHND OUTPUT BUFFER
BATOPT = ARGS+10 ;POINTER TO OUTPUT CHARACTER POINTER
BATOCT = ARGS+12 ;POINTER TO OUTPUT CHARACTER COUNTER
BATICT = ARGS+14 ;POINTER TO INPUT CHARACTER COUNTER
O$EXT = ARGS+16
O$TIN = ARGS+20
O$TOT = ARGS+22
O$PRN = ARGS+24
OUBSIZ = 400 ;SIZE OF BATHND OUTPUT BUFFER
.SBTTL LOW (IMPURE) SEGMENT DEFINITION
.CSECT UNPURE
.GLOBL BATSWT,TMPSWT,LINSIZ,LOWSEG
LINSZ= ^D80 ;LENGTH OF LINE BUFFER(MUST BE EVEN!)
LOTSZ= ^D132 ;LENGTH OF LINE OUTPUT BUFFER
ERSIZE= ^D5 ;MAXIMUM NUMBER OF ERROR MESSAGES/LINE
INBSIZ= 400 ;LENGTH OF EACH INPUT BUFFER
OTBSIZ= 400 ;LENGTH OF EACH OUTPUT BUFFER
SOBSIZ= 400 ;LENGTH OF TEMPORARY SOURCE OUTPUT BUFFER
QSIZE= 4 ;NUMBER OF EXTRA I/O QUEUE ELEMENTS
DEFLOG= 100 ;DEFAULT LOG FILE SIZE
.MCALL ..V1..,.REGDEF
.REGDEF
..V1..
.MCALL .TTYIN,.DELETE,.CLOSE,.EXIT,.TTYOUT,.PRINT
.MCALL .SRESET,.RCTRLO
.MACRO ENTRLO NAME,A1,A2,A3,A4,A5,A6,A7,A8,A9
.CSECT UNPURE
.IF NB NAME
NAME=.-LOWSEG
.ENDC
.IRP X,
.IIF NB ,.WORD X
.ENDR
.CSECT PROGRM
.ENDM
;LOWSEG IS THE START OF THE IMPURE AREA
;*****THE COMPILER ASSUMES THAT BATSWT IS THE FIRST ENTRY IN*****
;*****LOWSEG. REFERENCES TO BATSWT ARE ABBREVIATED TO (R4).*****
LOWSEG: ENTRLO BATSWT,0 ;BATCH CONTROL SWITCHES
ABORT= 100000 ;DON'T ATTEMPT TO RUN AFTER COMPILE
DATDOL= 40000 ;DATA/DOLLARS SET
NO= 20000 ;/"NO"SWITCH IS SET
CTYOUB= 10000 ;"\@" CTY: OUTPUT SENT
LOGOUB= 4000 ;"\C" LOG OUTPUT
DATOUB= 2000 ;"\D" USER DATA
COMOUB= 1000 ;"\E" KMON REQUEST
JOB= 400 ;$JOB SEEN
;******* KEEP MAKEB AT 200 *******
MAKEB= 200 ;MAKE BATCH LINKAGE FROM .TTYIN FIRST
COMMA= 100 ;COMMA TERMINATED COMMAND
BFORLI= 40 ;NEXT LINK REQUIRES FORTRAN'S FORLIB.OBJ
UNIQUE= 20 ;FOR UNIQUE MATCHES
BANNER= 10 ;PRINT BANNER ON $JOB,$EOJ
RT11= 4 ;RT11 DEFAULT ON NO DOLLAR IN COLUMN 1
TIME= 2 ;PRINT TIME OF DAY
MAKE= 1 ;MAKE SOURCE FILE
ENTRLO BATSW2,0
EOJ= 1
XSWT= 2 ;(DEBUG ONLY)
;BEOF= 4
LSTDAT= 10 ;LIST DATA SECTIONS
BNOEOJ= 20 ;$JOB OR $SEQ SEEN BEFORE PREVIOUS $EOJ
STAROK= 40 ;OK TO LET * NAME OR EXTENSION GO THROUGH
STARFD= 100 ;STAR SEEN IN FD FIELD
;MAKEB= 200 ;DITTO FROM BATSWT
COMSWB= 400 ;COMMAND SWITCHES
LSTBIT= 1000 ;REQUEST TEMPORARY LISTING
SEQ= 2000 ;$SEQ HAS APPEARED IN STREAM
SBIT= 4000 ;/S SWITCH ON THIS COMMAND
FIRST= 10000 ;1ST CARD OF THIS JOB PROCESSED
;ABORT= 100000 ;SECOND TIME THROUGH ABORTT
ENTRLO TMPSWT,0 ;TEMPORARY COMMAND SWITCH
ENTRLO COMSWT,.-.
ENTRLO LINSIZ,LINSZ ;INPUT LINE BUFFER SIZE
;********* KEEP IN ORDER ********
BFREE= 1 ;BUFFER STATUS BIT, 0 INDICATES BUFFER IS FREE
BWAIT= 2 ;IN I/O WAIT (BFREE*2)
BEOF= 4 ;END OF FILE IN BUFFER
ENTRLO BINLCT,0 ;LAST BUFFER CHARACTER COUNTER
ENTRLO INSTAT,0 ;INPUT BUFFER STATUS BYTES
ENTRLO ICHRPT,.-. ;INPUT CHARACTER POINTER
ENTRLO BINCTR,0 ;INPUT BUFFER COUNTER
ENTRLO BINARG,10*400+3 ;INPUT FILE EMT ARG. LIST
ENTRLO BATIBK,0 ;INPUT BLOCK #
ENTRLO BATIBP,.-.,INBSIZ,0 ;INPUT BUFFER ADDRESS,SIZE,WAIT I/O
ENTRLO BOTLCT,OTBSIZ*2 ;LAST BUFFER CHARACTER COUNTER
ENTRLO OTSTAT,BFREE*400+BFREE ;OUTPUT BUFFER STATUS
ENTRLO OCHRPT,.-. ;OUTPUT CHARACTER POINTER
ENTRLO BOTCTR,OTBSIZ*2 ;OUTPUT COUNTER
ENTRLO BOTARG,11*400+0 ;OUTPUT EMT ARG. LIST
ENTRLO BATOBK,0 ;OUTPUT BLOCK #
ENTRLO BATOBP,.-.,OTBSIZ,0 ;OUTPUT BUFFER ADDRESS,SIZE,WAIT I/O
;*********************************
ENTRLO STACK,.-. ;STACK POINTER SAVE AREA
ENTRLO ARGS ;ARGUMENTS EXCHANGED BETWEEN BATCH AND BA
.CSECT UNPURE
.BLKW ARGLST
;********* CSI BUFFER *************
ENTRLO SPC0,0,0,0,0,0 ;ENTRIES ARE: DEVICE, FILE NAME,
ENTRLO SPC1,0,0,0,0,0 ;FILE EXTENSION, AND REQUESTED SIZE.
ENTRLO SPC2,0,0,0,0,0
ENTRLO SPC3,0,0,0,0
ENTRLO SPC4,0,0,0,0
ENTRLO SPC5,0,0,0,0
ENTRLO SPC6,0,0,0,0
ENTRLO SPC7,0,0,0,0
ENTRLO SPC8,0,0,0,0
;**********************************
ENTRLO LINIMP,0 ;POINTER TO COMMAND LINE BUFFER
ENTRLO LINIMM ;LINIMM IS LINBAD
.CSECT UNPURE
.NLIST BIN
LINBAD: .REPT LINSZ ;INPUT LINE BUFFER
.BYTE 0
.ENDR
.BYTE -1 ;FLAG
.EVEN
ENTRLO LINIMS
.CSECT UNPURE
.REPT LINSZ ;INPUT LINE BUFFER SAVE AREA
.BYTE 0
.ENDR
.EVEN
ENTRLO LIBLST
.CSECT UNPURE
.ASCIZ /FORLIB/
.REPT LINSZ-7
.BYTE 0
.ENDR
.LIST BIN
.EVEN
BATIBF: .BLKW INBSIZ*2 ;INPUT BUFFERS
BATOBF: .BLKW OTBSIZ*2 ;OUTPUT BUFFERS
ENTRLO QSET
.CSECT UNPURE
.BLKW 7*QSIZE ;ROOM FOR I/O QUEUE ELEMENTS
.SBTTL HIGH SEGMENT SECTION DEFINITIONS
;******* HIGH SEG SECTIONS *******
.CSECT TABEL1
.GLOBL KEYTAB
KEYTAB:
.CSECT TABEL2
.GLOBL KEYWRD
KEYWRD: .BYTE 0
.CSECT TABEL3
.GLOBL SWIT
SWIT: .BYTE 0
.CSECT TABEL4
.GLOBL SWTADD
SWTADD:
.CSECT ERRLST
.GLOBL ERRADD
ERRADD:
.CSECT PROGRM
.SBTTL MACRO DEFINITIONS
.MACRO ADDR,ADDRESS,REG
.IF EQ PIC
MOV #ADDRESS,REG
.IFF
MOV PC,REG
ADD #ADDRESS-.,REG
.ENDC
.ENDM
.MACRO ADDRLO,ADDRESS,REG ;FOR LOW SEG ADDRESSES
.IF IDN ADDRESS,LINIMM
MOV LINIMP(R4),REG
.IFF
MOV #ADDRESS,REG
ADD R4,REG
.ENDC
.ENDM
SWTNUM=-1
.MACRO SWTDEF,SWITCH
SN$'SWITCH=SWTNUM
SWTNUM=SWTNUM-1
.CSECT TABEL3
.=.-1
C=0
.IRPC X,SWITCH
.IIF EQ C, .BYTE -''X
.IIF NE C, .BYTE ''X
C=C+1
.ENDM
.BYTE 0
.CSECT TABEL4
.IF EQ PIC
.WORD SA$'SWITCH
.IFF
.WORD SA$'SWITCH'-SWTJMP-2
.ENDC
.CSECT PROGRM
.ENDM
.MACRO SAVE,REG0,REG1,REG2,REG3,REG4,REG5
.IRP X,
.IIF NB ,MOV X,-(SP)
.ENDR
.ENDM
.MACRO RESTOR,REG0,REG1,REG2,REG3,REG4,REG5
.IRP X,
.IIF NB ,MOV (SP)+,X
.ENDR
.ENDM
BITNUL=100000 ;NO SWITCHES SPECIFIED FOR COMMAND
; COMMAND IS USED TO DFINE A BATCH COMMAND AND ITS LEGAL SWITCHES
.MACRO COMMAND,NAME,S,S1,S2,S3,S4,S5,S6,S7,S8,S9,SA,SB,SC,SD,SE,SF
.SBTTL $'NAME PROCESSOR
.CSECT TABEL1
DSW'NAME: .WORD 0
.IF EQ PIC
.WORD C$$'NAME
.IFF
.WORD C$$'NAME'-FNDJMP-2
.ENDC
.CSECT TABEL2
.=.-1
CN$'NAME: .ASCII /NAME/
.BYTE SN$NUL ;DUMMY END OF LINE
C=40000
.IRP X,
.IF NB
.BYTE SN$'X
BIT'X=C
.ENDC
C=C/2
.ENDR
.BYTE 0
.CSECT PROGRM
.LIST MEB
C$$'NAME:
.NLIST MEB
.ENDM
.MACRO DEFAULT SWITCH A,B,C,D,E,F,G,H,I,J,K,L,M,N,O
BIT=0
.CSECT TABEL1
.=.-4
X=BIT'A!BIT'B!BIT'C!BIT'D!BIT'E!BIT'F!BIT'G!BIT'H!BIT'I!BIT'J
.WORD BITNUL!X!BIT'K!BIT'L!BIT'M!BIT'N!BIT'O
.=.+2
.CSECT PROGRM
.ENDM
.MACRO SWITCH NAME
.SBTTL SWITCH NAME
SA$'NAME:
.ENDM
.MACRO LABEL A,B ;CREATE A LABEL
A'B:
.ENDM
.MACRO INCLBL A,B ;AN INCREMENTAL LABEL
B=B+1 ;INC B FIRST
LABEL A,\B ;MAKE LABEL A1,A2,....
.ENDM
ERRNUM=0
SERRNM=0
CERRNM=0
; ENTMES ENTERS AN ERROR MESSAGE IN THE ERRLST CSECT
.MACRO ENTMES,LABEL,MESSAGE,CR
.IF NB
.CSECT ERRLST
LABEL: .ASCII %MESSAGE%
.IF NB CR
.BYTE 0
.IFF
.BYTE 200
.ENDC
.CSECT PROGRM
.ENDC
.ENDM
.MACRO STRING ADDRESS,LABEL,MESSAGE,CR
ENTMES LABEL,MESSAGE,CR
.IF EQ PIC
JSR R5,ADDRESS
.IF NB LABEL
.WORD LABEL
.IFF
.WORD NULINE
.ENDC
.IFF
.=.+2
.IF NB LABEL
TST LABEL
.IFF
TST NULINE
.ENDC
.=.-6
JSR R5,ADDRESS
.=.+2
.ENDC
.ENDM
.MACRO AERROR A,B
STRING ERRLOG,A'B
.ENDM
.CSECT ERRLST
NULINE: .BYTE 200 ;NULL LINE
.MACRO OUTLOW LABEL
ADDRLO LABEL,R2
JSR PC,OUTPUL
.ENDM
.MACRO COMOUT LABEL,TEXT,CR
STRING COMOUX,LABEL,TEXT,CR
.ENDM
.MACRO COMLOW LABEL
COMOUT NULINE
OUTLOW LABEL
.ENDM
.MACRO LOGOUT LABEL,TEXT,CR
STRING LOGOUX,LABEL,TEXT,CR
.ENDM
.MACRO LOGLOW LABEL
LOGOUT NULINE
OUTLOW LABEL
.ENDM
.MACRO DATOUT,LABEL,TEXT,CR
STRING DATOUX,LABEL,TEXT,CR
.ENDM
.MACRO DATLOW LABEL
DATOUT NULINE
OUTLOW LABEL
.ENDM
.MACRO MESOUT,LABEL,TEXT,CR
STRING MESOUX,LABEL,TEXT,CR
.ENDM
.MACRO MESLOW LABEL
MESOUT NULINE
OUTLOW LABEL
.ENDM
.MACRO OUTPUT,LABEL,TEXT,CR
STRING OUTSTR,LABEL,TEXT,CR
.ENDM
.MACRO FOUT,LABEL,TEXT,CR
STRING FOUX,LABEL,TEXT,CR
.ENDM
.MACRO FOUTLO,LABEL
FOUT
OUTLOW LABEL
.ENDM
.MACRO GOUT,LABEL,TEXT,CR
STRING GOUX,LABEL,TEXT,CR
.ENDM
.MACRO GOUTLO,LABEL
GOUT
OUTLOW LABEL
.ENDM
.MACRO HOUT,LABEL,TEXT,CR
STRING HOUX,LABEL,TEXT,CR
.ENDM
.MACRO HOUTLO,LABEL
HOUT
OUTLOW LABEL
.ENDM
.MACRO IOUT,LABEL,TEXT,CR
STRING IOUX,LABEL,TEXT,CR
.ENDM
.MACRO IOUTLO,LABEL
IOUT
OUTLOW LABEL
.ENDM
.MACRO JOUT,LABEL,TEXT,CR
STRING JOUX,LABEL,TEXT,CR
.ENDM
.MACRO JOUTLO,LABEL
JOUT
OUTLOW LABEL
.ENDM
.MACRO KOUT,LABEL,TEXT,CR
STRING KOUX,LABEL,TEXT,CR
.ENDM
.MACRO KOUTLO,LABEL
KOUT
OUTLOW LABEL
.ENDM
.MACRO LABOUT,LABEL,TEXT,CR
STRING LABOUX,LABEL,TEXT,CR
.ENDM
.MACRO LABLOW,LABEL
LABOUT
OUTLOW LABEL
.ENDM
.MACRO CHROUT,X
.IF NB
.IF IDN X,<#',>
JSR PC,.COMMA
.MEXIT
.ENDC
.IF IDN X,#32
JSR PC,.CTRLZ
.MEXIT
.ENDC
.IF IDN X,#'0
JSR PC,.ASCI0
.MEXIT
.ENDC
.IF IDN X,#12
JSR PC,.LF
.MEXIT
.ENDC
.IF IDN X,#'=
JSR PC,.EQUAL
.MEXIT
.ENDC
.IF IDN X,#'2
JSR PC,.ASCI2
.MEXIT
.ENDC
.IF IDN X,#40
JSR PC,.SPACE
.MEXIT
.ENDC
.IF IDN X,R2
JSR PC,.R2
.MEXIT
.ENDC
.IF IDN X,(SP)+
JSR PC,.SPPOP
.MEXIT
.ENDC
.IF IDN X,#'A
JSR PC,.ASCIA
.MEXIT
.ENDC
MOVB X,R3
.ENDC
JSR PC,PUTCHR
.ENDM
.MACRO INCVAR,X
.IF NB
MOVB X,R3
.ENDC
JSR PC,INCVAX
.ENDM
.MACRO CR.LF
JSR PC,CROUTP
.ENDM
.MACRO INTVAR,V,X
KOUT NULINE
CHROUT V
CHROUT #'1
CHROUT X
.ENDM
.MACRO GETVAR,V
KOUT NULINE
CHROUT V
CHROUT #'2
.ENDM
.MACRO IFOUT V,X,LABEL,TEXT,CR
IOUT
CHROUT V
CHROUT X
OUTPUT LABEL,TEXT,CR
.ENDM
.MACRO SCAN,LABEL,TEXT
.IF NB LABEL
ENTMES LABEL,TEXT
ADDR LABEL,R1
.ENDC
JSR R5,SCANX
.ENDM
.MACRO ERROR MESSAGE
.CSECT ERRLST
INCLBL ERR,ERRNUM
.ASCIZ /MESSAGE/
.CSECT PROGRM
AERROR ERR,\ERRNUM
.ENDM
.MACRO SPRINT A,B
ADDR A'B,R0
.PRINT
.ENDM
.MACRO CERROR MESSAGE
.CSECT ERRLST
INCLBL CERR,CERRNM
.ASCIZ /MESSAGE/
.CSECT PROGRM
SPRINT CERR,\CERRNM
.ENDM
.MACRO SERROR MESSAGE
.CSECT SERRLST
INCLBL SERR,SERRNM
.ASCIZ /MESSAGE/
.CSECT PROGRM
SPRINT SERR,\SERRNM
.ENDM
.MACRO GETFD NAME,S1,S2,S3,S4,S5,S6,S7,S8,S9,S10,S11,S12,S13,S14,S15
.CSECT ERRLST
NAME:
C=40000
.BYTE SN$NUL
NAME'NUL=100000
.IF NB S1
.IRP X,
.IF NB
.BYTE SN$'X
NAME''X=C
.ENDC
C=C/2
.ENDR
.BYTE 0
.ENDC
.CSECT PROGRM
.IF EQ PIC
JSR R5,GETFD$
.WORD NAME
.IFF
.=.+2
TST NAME+2
.=.-6
JSR R5,GETFD$
.=.+2
.ENDC
.WORD 0
.ENDM
.MACRO EXCLUSIVE NAME,S1,S2,S3,S4,S5,S6,S7,S8,S9,S10,S11,S12,S13,S14,S15
.=.-2
C=0
.IRP X,
.IF NB
C=C+NAME''X
.ENDC
.ENDR
.WORD ^C
.WORD 0
.ENDM
.MACRO FINDFD NAME,S1,S2,S3,S4,S5,S6,S7,S8,S9,S10,S11,S12,S13,S14,S15
JSR R5,FDFIND
.IF NB S1
C=0
.IRP X,
.IF NB
C=C+NAME''X
.ENDC
.ENDR
.WORD C
.IFF
.WORD NAME'NULL
.ENDC
.ENDM
.MACRO OUTFD.
JSR PC,OTFD.$
.ENDM
.MACRO OUTFD
JSR PC,OUTFD$
.ENDM
.MACRO OUTFDC
JSR PC,OTFDC$
.ENDM
.MACRO UNHOOK NAME,NUMBER
.IF NE NUMBER
MOV @NAME(R4),NUMBER*2(R0)
ADD NAME(R4),NUMBER*2(R0)
SUB R0,NUMBER*2(R0)
.IFF
MOV @NAME(R4),(R0)
ADD NAME(R4),(R0)
SUB R0,(R0)
.ENDC
.ENDM
.MACRO SPACES
JSR PC,SPACE$
.ENDM
.MACRO DMPOBJ X
JSR R5,OBJDMP
.WORD X
.ENDM
.MACRO GETSAV
ADDR SAVTMP,R2
.ENDM
.MACRO LSTSOU
ADDRLO SOUTMP,R2
.ENDM
.CSECT ERRLST
SAVTMP: .ASCIZ "000000.SAV"
ENTRLO SOUTMP,"00,"00,"00,".S,"OU,0
.MACRO GETOBJ
JSR R5,OBJSOU
.WORD OBJTMP
.ENDM
.MACRO LSTOBJ
ADDRLO OBJTMP,R2
.ENDM
.MACRO GETLST
JSR PC,LSTLST
.ENDM
ENTRLO OBJTMP,"00,"00,"0/,".O,"BJ,0
.MACRO ISIT LABEL,ADDRESS,ARGS
.IF NB
.CSECT ERRLST
LABEL: .ASCIZ ARGS
.CSECT PROGRM
.ENDC
.IF EQ PIC
JSR R5,ISIT$
.WORD LABEL
.WORD ADDRESS
.IFF
.=.+4
TST ADDRESS+2
.=.-6
TST LABEL
.=.-6
JSR R5,ISIT$
.=.+4
.ENDC
.ENDM
.MACRO CHECK ARG
.IF NB ARG
.NTYPE SYM,ARG
.IF NZ SYM-13
MOVB ARG,R2
JSR PC,CHRCK
.IFF
JSR PC,CHRCHK
.ENDC
.IFF
JSR PC,CHRCK
.ENDC
.ENDM
.SBTTL SWITCH DEFINITIONS
.IRP X,
SWTDEF X
.ENDR
.IRP X,
SWTDEF X
.ENDR
.IRP X,
SWTDEF X
.ENDR
.SBTTL COMPILER ENTRY POINT
.CSECT PROGRM
; BATCH STARTS BY INITIALIZING ITS BUFFER POINTERS AND THEN DOING
; A .DSTAT ON THE BA HANDLER. THIS SERVES TWO PURPOSES: IT TESTS
; FOR BA HANDLER RESIDENCY AND SUPPLIES THE BA ENTRY POINT
; FOR USE IN THE START2 CODE. IN ADDITION, A TEST IS MADE FOR
; THE LOG HANDLER, WHICH MUST ALSO BE RESIDENT AND ASSIGNED TO LOG:
.GLOBL START
START: ADDR LOWSEG,R4 ;PUT ADDRESS OF IMPURE AREA IN R4
MOV SP,STACK(R4) ;SAVE STACK PTR FOR RESET
MOV #LINIMM,LINIMP(R4) ;LINIMP->COMMAND LINE BUFFER
ADD R4,LINIMP(R4) ;DON'T DO ADDRLO LINIMM,LINIMP(R4)
.RCTRLO ;RESET CTRL/O
MOV #QSET,-(SP)
ADD R4,(SP)
MOV #QSIZE,R0
EMT ^O353 ;.QSET
ADDRLO BATIBF-LOWSEG+INBSIZ+INBSIZ,R0
MOV R0,BATIBP(R4) ;INITIALIZE I/O BUFFER POINTERS
ADDRLO BATOBF-LOWSEG,R0
MOV R0,OCHRPT(R4)
ADD #OTBSIZ*2,R0
MOV R0,BATOBP(R4)
MOV #WDBLK5,-(SP) ;ONLY NEED 4 OF THE 5
ADD R4,(SP) ;USE WDBLK5 FOR .DSTAT ON BA
ADDR LOGNAM,R0 ;R0->LOG: (RAD50)
EMT 16*20+2 ;.DSTATUS
.ENABL LSB
BCS 1$ ;BR IF LOG: NOT ASSIGNED
TST WDBLK5+4(R4) ;IS IT RESIDENT?
BNE 2$ ;BR IF HANDLER IN MEMORY
SERROR
.EXIT
1$: SERROR
.EXIT
2$: MOV WDBLK5(R4),LOGTYP(R4) ;SAVE DEVICE STATUS OF LOG
BIT #SPECL$+RONLY$,LOGTYP(R4) ;CAN IT BE USED FOR LOG?
BEQ 3$ ;IT'S OKAY
SERROR
.EXIT
3$: ADDR BATHND,R0
MOV #WDBLK5,-(SP)
ADD R4,(SP)
.DSABL LSB
EMT 16*20+2 ;DSTATUS
MOV WDBLK5+4(R4),-(SP)
BNE START1
NOTRES: SERROR
.EXIT
BATHND: .RAD50 /BA /
ENTRLO LOGTYP,0 ;LOG DEVICE STATUS SAVE AREA
; TEST FOR BA HANDLER. IF BA IS RESIDENT, DO A NULL READ TO BA
; TO INITIALIZE IT. BA WILL RETURN A LIST OF ITS LOCATIONS
; WHICH MUST BE PRESERVED ON A RECURSION.
START1: ADDR BATHND,R3 ;R3 -> BATCH HANDLER NAME
ADDRLO WDBLK2+2,R0 ;DO A .LOOKUP ON CH. 16
MOV R3,(R0) ;FOR BA .SYS
MOV #1*400+16,-(R0)
EMT 375
; AN ERROR SHOULDN'T OCCUR HERE BECAUSE BA IS NOT FILE-STRUCTURED.
BCS NOTRES ;BRANCH IF BA.SYS NOT RESIDENT
ADDRLO ARGS,R3 ;O.K., DO A NULL READ TO BA.SYS
ADDRLO ARGARG,R0
MOV R3,4(R0)
EMT 375 ;READW BATHND (INITIALIZE THE HANDLER)
BCC START2
SERROR
.EXIT
; RELOCATE POINTERS PASSED FROM BA HANDLER, INITIALIZE BATCH
; STACK BLOCK ON SY:, THEN PROCESS THE COMPILER COMMAND LINE.
START2: ADD (SP),(R3)+ ;RELOCATE THE POINTER OFFSETS
BCC START2 ;UNTIL NEGATIVE OFFSET FOUND.
TST @BATSW1(R4) ;TEST FOR $CALL
BNE GETCOM ;BR IF THIS IS A $CALL
JSR PC,RDSTK ;ELSE READ IN BATCH STACK
MOV #-,@BATOBP(R4) ;SET 1ST WORD TO INITIALIZE
JSR PC,START3 ;AND WRITE IT BACK OUT.
GETCOM: CLR INSTAT(R4) ;RESET INSTAT IN CASE OF ERROR
CLR BINCTR(R4) ;ZERO INPUT COUNTER
CLR BATIBK(R4) ;AND INPUT BLOCK NUMBER
CLR (R4) ;CLEAR BATSWT
CLR BATSW2(R4) ;AND BATSW2
ADDRLO SPC0,R0
MOV R0,-(SP)
ADDR DEFEXT,R0 ;R0 -> DEFAULT EXTENSIONS
MOV R0,-(SP)
CLR -(SP)
2$: BIT #CHAIN,@#JSW
BEQ 1$ ;DID WE COME FROM CHAIN??
BIC #CHAIN,@#JSW ;YES
MOV #CHNTXT,(SP) ;PICK UP CHAIN TEXT
1$: EMT 16*20+5 ;.CSISPC
BCC CSIOK ;BR IF LEGAL COMMAND
TSTB @#ERRWRD ;WHAT WAS THE ERROR?
BNE ILLDEV ;BR IF ILLEGAL DEVICE
SERROR
BR GETCOM
ILLDEV: SERROR
BR GETCOM
; EMT ARGUMENT LIST FOR BATCH HANDLER INITIALIZATION
ENTRLO ARGARG,10*400+16,0,.-.,0,0
DEFEXT: .RAD50 /BAT/ ;INPUT DEFAULT
.WORD 0 ;SPC0, CTL OR MAKE FILE, NO DEFAULT
LOGNAM: .RAD50 /LOG/ ;SPC1, BATCH LOG PUTPUT
.WORD 0 ;NO SPC2 YET
CSIOK: TST SPC2(R4)
BEQ START4
SERROR
.SBTTL COMPILER SWITCH PROCESSING:
START4: MOV (SP)+,R0 ;# OF SWITCHES TO R0
BNE 2$ ;BR IF ANY SWITCHES TO PROCESS
JMP ENTSPC ;NO, GO DO THE ENTERS
2$: ADDR SWTLST,R1 ;R1->LIST OF SWITCH NAMES
ADDR JMPSWT,R2 ;R2->TABLE OF OFFSETS TO SWITCH ROUTINES
DEC R0 ;DECREMENT SWITCH COUNT
MOV (SP)+,R3 ;PICK UP A SWITCH
SAVE R0 ;PUT SWITCH COUNT BACK ON STACK
1$: TST (R2)+ ;BUMP OFFSET TABLE PTR.
CMPB (R1)+,R3 ;COMPARE SWITCH WITH LIST
BGT 1$ ;FIND THE SWITCH
BNE BDSWT ;CAN'T FIND IT
MOV @R2,-(SP) ;GET OFFSET TO SWITCH
ADD PC,@SP ;MAKE IT ABSOLUTE
ASL R3 ;CARRYSET => SWITCH VALUE
JMPSWT: JMP @(SP)+ ;JUMP TO PROPER SWITCH
SWTX-JMPSWT+2 ;X, MISTRY SWITCH. (DEBUG ONLY)
SWTV-JMPSWT+2
SWTU-JMPSWT+2
SWTT-JMPSWT+2
SWTS-JMPSWT+2
SWTR-JMPSWT+2
SWTN-JMPSWT+2
SWTM-JMPSWT+2
SWTD-JMPSWT+2
SWTB-JMPSWT+2 ;***** REVERSE ALPHABETIC ORDER *****
SWTLST: .ASCIZ "XVUTSRNMDB"
.EVEN
; TEST FOR SWITCH BEING ENTERED FROM CTY, WITH BA.SYS IDLE. THAT IS
; ILLEGAL FOR /B,/D,/M,/S,/R.
TSTSWT: TST @BATSW1(R4) ;IS BA ACTIVE?
BEQ BDSWT ;BR IF BA INACTIVE
RTS PC ;O.K.
BDSWT: SERROR
BRGTCM: BR GETCOM
.SBTTL /X COMPILER SWITCH
; INPUT FILE IS ASSUMED TO BE PRE-COMPILED.
SWTX: BCS BDSWT
BIS #XSWT,BATSW2(R4) ;INPUT ALREADY COMPILED
BR START4
.SBTTL /V COMPILER SWITCH
; PRINT VERSION I.D. IF NO INPUT FILE SKIP ANY MORE PROCESSING.
SWTV: BCS BDSWT
.PRINT #VERID ;PRINT VERSION I.D. MESSAGE
TST SPC3(R4) ;WAS THERE AN INPUT FILE?
BEQ GETCOM ;BRANCH IF NOT
BR START4 ;CONTINUE
.GLOBL VERID
VERID: .ASCIZ /BATCH V01-04 /
.EVEN
.SBTTL /U COMPILER SWITCH
; THIS SWITCH PERMITS THE BATCH HANDLER TO BE UNLOADED AFTER
; EXITING FROM THE COMPILER.
SWTU: BCS BDSWT
MOV @#SYSPTR,R0 ;MAKE R0 POINT TO
MOV EMT16(R0),-(SP) ;LIST OF EMT 16 FUNCTIONS
ADD (SP)+,R0
UNHOOK O$TIN,0 ;REMOVE BATCH HANDLER
UNHOOK O$TOT,1 ;HOOKS FROM MONITOR.
UNHOOK O$EXT,10
UNHOOK O$PRN,11
CLR @BATSW1(R4)
SERROR ;PRINT PROMPTING MESSAGE
.EXIT
.SBTTL /T COMPILER SWITCH
SWTT: BCC BDSWT ;/T:N N=0=NO TIME N<>0=TIME, MUST HAVE N
MOV 2(SP),R2 ;SWITCH VALUE TO R2
MOV (SP)+,(SP) ;REPLACE WITH SWITCH COUNT
TST R2 ;TEST VALUE FOR ZERONESS
BEQ 1$
BIS #TIME,(R4) ;PRINT TIME OF DAY
BR START4
1$: BIC #TIME,(R4) ;DON'T PRINT TIME OF DAY
ST4LNK: BR START4
.SBTTL /S COMPILER SWITCH
; THE /S SWITCH IS USED BY BATCH TO CALL ANOTHER BATCH STREAM.
; IT CAUSES THE CURRENT BA HANDLER STACK TO BE PUSHED DOWN
; SO IT CAN CONTINUE WHERE IT LEFT OFF WHEN THE NEW BATCH STREAM
; DECLARES END OF JOB.
SWTS: BCS SWTU ;BR IF ILLEGAL VALUE
JSR PC,TSTSWT ;TEST IF BA ACTIVE
BIS #SBIT,BATSW2(R4) ;FLAG FOR LATER ACTION
BR ST4LNK ;CONTINUE PROCESSING
; EOJSUB -- SUBROUTINE SHARED BY /S,/R SWITCHES. EOJSUB PUSHES THE
; CURRENT BATCH HANDLER PARAMETERS ONTO THE BATCH "STACK", WHICH
; IS STORED IN PHYSICAL BLOCK 5 OF THE SYSTEM DEVICE. IT
; DECREMENTS THE BLOCK # OF THE CURRENT INPUT FILE BEFORE STORING
; IT SO THAT THE BLOCK MAY BE RE-READ WHEN BATCH RETURNS FROM A CALL.
EOJSUB: JSR PC,RDSTK ;READ BATCH STACK INTO MEMORY
MOV BATOBP(R4),R0 ;R0->CURRENT PLACE IN STACK
ADD #SAVNUM*2,(R0) ;MOVE FOREWARD # OF BYTES TO SAVE
CMP #360,(R0) ;TEST FOR STACK FULL
BLT BSOUFL ;BATCH STACK OVERFLOW
ADD (R0),R0
MOV BATICT(R4),R1 ;R1 -> INPUT CHARACTER COUNT
MOV (R1),(R0)+ ;BATICT
MOV -(R1),(R0)+ ;BATIPT
MOV INDATA(R4),R1
TST (R1)+
DEC (R1) ;SUBTRACT 1 FROM THE BLOCK NUMBER
MOV (R1)+,(R0)+ ;INBLOK
ADD #6,R1
JSR PC,WRTSTK ;WRITE OUT BATCH STACK
RTS PC
.SBTTL WRTSTK,START3,RDSTK SUBROUTINES
; WRTSTK -- COMMON SUBROUTINE USED BY /R AND /S CODE TO WRITE OUT
; THE BATCH STACK. USES R0,R2,R5.
;
; RDSTK -- SUBROUTINE TO READ INTO MEMORY THE BATCH STACK(BLK 5 OF SY:BA.SYS)
; USES R0,R1
WRTSTK: JSR PC,BLT10 ;INSAV,INSAV+2,INSAV+4,INSAV+6,INSAV+10
START3: ADDRLO STKBLK,R0
MOV #11*400+16,(R0) ;.WRITW CHAN. 16
EMT 375
BCS WTBSER ;WRITE BATCH STACK ERROR
.CLOSE 16
CALRTP: RTS PC
WTBSER: MOV PC,R0 ;SAVE OFFENDING PC
BR FTLNK ;TAKE FATAL EXIT
RDSTK: .CLOSE 16 ;MAKE SURE ITS CLOSED
ADDRLO WDBLK2+2,R0 ;WDBLK2 IS ARG. LIST
MOV BATOBP(R4),STKBLK+4(R4)
ADDR BATSTK,R1 ;R1 -> BATCH STACK F.D.
MOV R1,(R0) ;PUT IN ARG. LIST
MOV #1*400+16,-(R0) ;PUT IN EMT CODE
EMT 375 ;.LOOKUP
BCS 1$ ;FATAL ERROR!
ADDRLO STKBLK,R0
MOV #10*400+16,(R0)
EMT 375 ;.READW
BCC CALRTP ;BR IF READ O.K.
MOV PC,R0 ;SAVE OFFENDING PC
BR FTLNK ;TAKE FATAL EXIT
1$: MOV PC,R0 ;SAVE PC FOR ANALYSIS
FTLNK: JMP BATFTL ;GO TO FATAL EXIT
BSOUFL: ERROR
.EXIT
.SBTTL /R COMPILER SWITCH
SWTR: BCS SWTS
JSR PC,TSTSWT ;TEST FOR BA ACTIVE
SWTR1: JSR PC,RDSTK ;READ BATCH STACK INTO BATOBF
MOV BATOBP(R4),R1 ;R1 -> STACK
TST (R1) ;IS IT EMPTY?
BMI BATFIN ;BR IF SO, WE'RE DONE!
ADD (R1),R1 ;R1 -> CURRENT PLACE IN STACK
SUB #SAVNUM*2,@BATOBP(R4) ;REDUCE COUNT
MOV BATICT(R4),R0 ;R0 -> INPUT CHAR. COUNT
MOV (R1)+,(R0) ;RESTORE INPUT COUNT
MOV (R1)+,-(R0) ;AND INPUT POINTER
MOV INDATA(R4),R0 ;R0 -> INPUT EMT BLOCK IN BA
TST (R0)+ ;R0 -> INPUT BLOCK #
SAVE (R1) ;SAVE THE BLOCK NUMBER
INC (R1) ;BUMP THE BLOCK # IN BA
MOV (R1)+,(R0)+ ;AND PLACE IN EMT BLOCK
SAVE R0 ;POINTER TO INBUF POINTER
ADD #6,R0 ;R0 -> INPUT SAVE STATUS AREA IN BA
SAVE R1 ;SAVE PTR TO BATCH STACK
JSR PC,WRTSTK ;WRITE OUT THE STACK
TST 4(SP)
BPL 2$
BIC #ABORT,(R4)
JMP SWTR3
2$: ADDRLO WDBLK2+2,R0
RESTOR (R0) ;R0 -> BATCH STACK
; REOPEN THE INPUT FILE THAT WAS PREVIOUSLY SAVED WHEN A
; NEW BATCH STREAM WAS $CALLED.
MOV #6*400,-(R0) ;.REOPEN
EMT 375
BCS REOPER ;REOPEN ERROR
ADDRLO STKBLK,R0
MOV @(SP)+,STKBLK+4(R4) ;GET POINTER TO BA INPUT BUFFER
RESTOR STKBLK+2(R4) ;THEN THE BLOCK #
MOV @#SYSPTR,R5
BIT #FBMON$,CONFIG(R5)
BEQ 1$ ;DON'T MESS WITH BIT 1 IN SJ MON
BIS #2,@CONTXT(R5)
; NOW READ IN THE BLOCK THAT WAS IN THE BA HANDLER'S BUFFER WHEN THE
; $CALL WAS MADE. SINCE POINTER AND CHARACTER COUNT WERE PRESERVED,
; BATCH STREAM SHOULD CONTINUE WHERE IT LEFT OFF AT $CALL.
1$: MOV #10*400,(R0) ;READW
EMT 375
BCS REOPER
BIT #FBMON$,CONFIG(R5)
BEQ 3$ ;IF S/J, SKIP RESTORE
BIC #2,@CONTXT(R5)
3$: JMP SWTR2
REOPER: SERROR
BATFIN: MOV #SOURCE+DESTON,@BATSW1(R4)
SERROR <12>/END BATCH>
CLR R0 ;SETUP TO FLUSH LOG BUFFER
MOV #400,R1 ;WITH 400 NULLS
MOV #SOURCE+DESTON+BSOURC+BDESTN,@BATSW1(R4)
1$: .TTYOUT
DEC R1
BNE 1$
CLR @BATSW1(R4) ;CLEAR BATSW1 TO MAKE BA IDLE
.EXIT
BATSTK: .RAD50 "SY BA SYS"
; ARGUMENT LIST FOR READ/WRITE OF BATCH STACK BLOCK (#5 OF BA.SYS FILE)
ENTRLO STKBLK,10*400+16,BATBLK,.-.,400,0
.SBTTL /N COMPILER SWITCH
SWTN: BCS SWTR
BIS #ABORT,(R4) ;DON'T RUN AFTER COMPILE
JMSTR4: JMP START4
.SBTTL /M COMPILER SWITCH
; THW /M SWITCH IS USED ONLY BY THE BATCH COMPILER TO CREATE (MAKE)
; SOURCE FILES FOR ITS OWN USE.
SWTM: BCS SWTN
JSR PC,TSTSWT ;TEST FOR BA ACTIVE
ADDRLO DEFCHN,R2 ;ADDRESS OF THE DEFAULT CHANNEL NUMBERS
JSR R5,ENTER ;ENTER SPECIFIED FILE
SPC0
.WORD 0
.RAD50 /DK /
BR 2$
;GET DATA UNTIL CTRL/Z ENCOUNTERED, THEN CLOSE FILE.
; DATA IS FED TO THIS CODE FROM THE CTL FILE VIA THE .TTYIN
; REQUEST. THE BA HANDLER THINKS THE TEXT FOLLOWING THE $CREATE
; COMMAND IS JUST PROGRAM DATA FOR SOME STRANGE PROGRAM CALLED BATCH.
1$: CHROUT R0
2$: .TTYIN
CMP #CTRL.Z,R0 ;^Z?
BNE 1$
JSR PC,CLOSE0
.EXIT
.SBTTL /B COMPILER SWITCH
; THE /B SWITCH ON A COMMAND TO THE BATCH COMPILER IS USED TO CONTINUE
; THE BATCH STREAM WHEN A NEW JOB IN A CARD STREAM IS ENCOUNTERED OR
; WHEN A $JOB OR $SEQ CARD IS ENCOUNTERED WITHOUT A PRECEDING $EOJ
; COMMAND. WHAT HAS HAPPENED IS THE BATCH COMPILER HAS CREATED A
; TEMPORARY FILE THAT CONTAINS THE COMMAND:
; .R BATCH
; */B
;
; FOLLOWED BY SOME BINARY DATA THAT IT WISHES TO PRESERVE THROUGH
; ANOTHER CALL OF THE BATCH COMPILER.THIS IS NECESSARY BECAUSE BATCH
; REALLY ISN'T REENTRANT. THE DATA THAT FOLLOWS IN THE CTT FILE IS FED
; TO THE COMPILER A BYTE AT A TIME THROUGH THE .TTYIN REQUEST AND USED
; TO RESTORE INPUT AND OUTPUT BUFFER POINTERS AND THE NAME OF THE .BAT
; FILE BEING EXECUTED.
;
; AN EXAMPLE OF THIS HAPPENING IS WHEN THE COMPILER DISCOVERS A $JOB CARD
; THAT WASN'T PRECEDED BY AN $EOJ CARD. BATCH ASSUMES THIS IS THE
; START OF A NEW JOB AND THE PREVIOUS JOB IS FLUSHED BY ZEROING THE OUTPUT
; BUFFER AND BLOCK #, EFFECTIVELY FLUSHING ANY OUTPUT DONE UP TO NOW.
; BATCH THEN CREATES A CTT FILE WITH THE /B COMMAND TO ITSELF, AND
; SAVES THE OUTPUT FILE POINTERS AND ITS CURRENT PLACE IN THE INPUT
; .BAT FILE, WHICH IS POINTING AT THE $JOB COMMAND. IT THEN PASSES
; THIS CTT FILE TO THE BA HANDLER WHICH EXECUTES IT, RE-RUNNING BATCH.
; THE /B SWITCH CAUSES BATCH TO PICK UP THE INPUT AND OUTPUT FILE
; POINTERS, EFFECTIVELY STARTING BATCH UP AT THE POINT OF THE
; NEW $JOB COMMAND.
SWTB: BCS SWTM ;A VALUE IS ILLEGAL
JSR PC,TSTSWT ;TEST FOR BA ACTIVE
BIS #MAKEB,(R4) ;SET MAKEB SWITCH
.TTYIN ;GET A CHARACTER
MOVB R0,BINARG(R4) ;REPLACE CHAN. # IN INPUT EMT BLK
.TTYIN
MOVB R0,BATIBK(R4) ;THEN THE INPUT BLOCK #
.TTYIN
MOVB R0,BATIBK+1(R4)
ADDRLO SPC0,R1 ;POINT TO CTL FILE DESCR.
MOV #^D39*2,R2 ;TRANSFER 39. BYTES
1$: .TTYIN
MOVB R0,(R1)+
DEC R2
BNE 1$
JMP ENTSPC ;THEN CONTINUE LIKE NOTHING HAPPENED
;BUT REMEMBER MAKEB BIT IS SET!
.SBTTL DEFCHN - DEFAULT CHANNEL NUMBERS
;IN THE EVENT THAT YOU WISH TO CHANGE THE CHANNEL ASSIGNMENTS
;FOR THE SPC'S, HERE IS A HANDY-DANDY LIST.
;( DEFCHN: .BYTE SPC0#,...,SPC8# )
ENTRLO DEFCHN
.CSECT UNPURE
.BYTE 0,1,2,3,4,5,6,7,10
.EVEN
.CSECT PROGRM
NOCH3: SERROR
JMP GETCOM
.SBTTL /D COMPILER SWITCH
; THE /D SWITCH IS USED BY $MOUNT AND $DISMOUNT TO PRINT THE PHYSICAL
; DEVICE NAME ASSOCIATED WITH A LOGICAL NAME ON THE CTY. IT DOES
; THIS BY FETCHING THE HANDLER, DOING A .LOOKUP, AND THEN A .DSTATUS
; AND .SAVESTATUS TO EXTRACT DEVICE NAME AND UNIT NUMBER.
; NOTE: DEVLST BELOW MUST BE ORDERED IDENTICALLY WITH THE DEVICE
; IDENTIFICATION CODES USED BY THE RT-11 MONITOR.
SWTD: BCS SWTM
JSR PC,TSTSWT ;TEST FOR BA ACTIVE
SAVE @BATSW1(R4)
CLR @BATSW1(R4)
ADDRLO SPC3,R3
CLR 2(R3) ;MAKE SURE IT'S NULL NAME
MOV R3,R0
SAVE DEVSPC(R4)
EMT 343 ;FETCH HANDLER
BCS DSMTER
ADDRLO WDBLK2+2,R0
MOV R3,(R0)
MOV #1*400+0,-(R0) ;CHANNEL 0
EMT 375 ;LOOKUP
BCS DSMTER
MOV #WDBLK5,-(SP)
ADD R4,(SP)
MOV R3,R0
EMT 16*20+2 ;.DSTATUS
BCS DSMTER
MOVB WDBLK5(R4),R1
ASL R1
ADDR DEVLST,R2
ADD R2,R1
.TTYOUT (R1)+
.TTYOUT (R1)+
; TO GET UNIT # WITHOUT DOING A SAVESTAUS (ILLEGAL FOR MT AND CT)
; GO DIRECTLY TO CHANNEL 0, WHICH STARTS 4 BYTES BEYOND FRONT OF
; RMON AND EXTRACT THE HIGH BYTE OF THE FIFTH WORD.
MOV @#SYSPTR,R2 ;R2 -> RMON
MOVB $CSW+11(R2),R0 ;GET UNIT # FROM CH 0
ADD #60,R0
.TTYOUT
DSMTDN: MOV R3,R0 ;POINT TO DEVICE NAME AGAIN
CLR -(SP) ;SET UP TO DO A
EMT 343 ;.RELEAS
RESTOR @BATSW1(R4)
1$: .TTYIN
BR 1$
.SBTTL RT-11 DEVICE LIST
DEVLST: .ASCII /RKDT LPTT PRPPMTRFCTCR DS MMDPDX/
.EVEN
DSMTER: SERROR
BR DSMTDN
.ENABL LSB
; ENTSPC TESTS FOR AN INPUT FILE WHICH MUST BE SPECIFIED. IT THEN
; OPENS OUTPUT FILES FOR THE CTL AND LOG OUTPUT.
ENTSPC: ADDRLO DEFCHN,R2 ;ADDRESS OF THE DEF. CHAN NUM.
TST SPC3(R4)
BEQ NOCH3
BIT #XSWT,BATSW2(R4)
BEQ 2$ ;BRANCH IF NOT /X
CMP SPC3+6(R4),(PC)+ ;DID CSI PUT IN BAT EXT?
.RAD50 /BAT/
BNE 1$ ;NO, O.K.
MOV RADCTL,SPC3+6(R4) ;YES, MAKE IT CTL
BR 1$
2$: CMP SPC3+6(R4),(PC)+
RADCTL: .RAD50 /CTL/
BEQ 1$
JSR R5,ENTER ;ENTER SPC0
SPC0 ;DEFAULT COMPILER NAME
.RAD50 /CTL/
.RAD50 /DK /
1$: INC R2 ;NEXT CHANNEL
; IF LOG FILE SPECIFICATION DIDN'T INCLUDE A FILE SIZE, USE
; DEFAULT SIZE DEFLOG TO MAKE SURE FILE IS BIG ENOUGH.
BIT #SBIT,BATSW2(R4) ;SKIP LOG FILE IF /S SWITCH
BNE 4$ ;BRANCH IF /S SET
BIT #MAKEB,(R4) ;DITTO FOR /B
BNE 4$
TST SPC1+10(R4) ;SIZE SPECIFIED?
BNE 3$ ;YES, USE THAT SIZE
MOV #DEFLOG,SPC1+10(R4) ;USE DEFAULT SIZE
3$: JSR R5,ENTER
SPC1
.RAD50 /LOG/
.RAD50 /LOG/
4$: MOV #6,R5 ;COUNTER
ADDRLO SPC3,R3
CMPB (R2)+,(R2)+
.DSABL LSB
; LOOKUP TESTS THE 6 POSSIBLE INPUT CHANNELS FOR FILE SPECIFIERS
; AND OPENS AS MANY CHANNELS AS ARE SPECIFIED. AT LEAST CHANNEL 3
; MUST BE SPECIFIED. LOOKUP FETCHES A HANDLER FOR EACH INPUT FILE,
; WHERE REQUIRED.
LOOKUP: TST (R3)
BEQ LUKUPN ;NO FILE
MOV R3,R0 ;POINTER TO DEVBLK
MOV DEVSPC(R4),-(SP) ;HANDLER SPACE
EMT 343 ;FETCH HANDLER
BCC LUKUPF ;LOOKUP THE INPUT CHANNELS
SERROR
BR LUKXIT
ENTRLO DEVSPC,BATEND
; LUKUPF DOES LOOKUPS ON ALL CHANNELS
LUKUPF: MOV R0,DEVSPC(R4) ;UPDATE THE HANDLER SPACE POINTER
ADDRLO WDBLK2+2,R0
MOV R3,(R0)
MOV #1*400,-(R0) ;LOOKUP
MOVB (R2),(R0) ;SET IN THE CHANNEL NUMBER
EMT 375
BCC LUKUPN
SERROR
LUKXIT: JSR PC,CLOSE ;CLOSE INPUT FILES, IF OPEN
.EXIT
LUKUPN: INC R2
ADD #10,R3
DEC R5
BGT LOOKUP
; AT THIS POINT MUST TEST FOR /S SWITCH AND CALL EOJSUB TO PUSH
; THE BATCH STACK BEFORE CONTINUING.
BIT #SBIT,BATSW2(R4) ;WAS /S SWITCH USED?
BEQ 1$ ;NO, SKIP THIS
JSR PC,EOJSUB ;YES, PUSH DOWN A LEVEL
2$: JMP STRT8A ;SKIP LOG SETUP ON /S
1$: BIT #MAKEB,(R4) ;COMING FROM /B?
BNE 2$ ;BR IF SO, SKIP LOG SETUP
;**** KEEP TOGETHER ****
ENTRLO WDBLK2,0,0,0 ;EXTRA 0 FOR LOOKUPS
ENTRLO WDBLK5,0,0,0,0,0
;***********************
; IF LOG DEVICE IS FILE-STRUCTURED, A FIXED LENGTH FILE WAS ENTERED.
; TO MAKE THIS PERMANENT UNDER CURRENT RT-11 FILE PRACTICES, BATCH
; MUST INITIALIZE THE FILE BY WRITING ZEROES IN ALL BLOCKS. THIS
; CAN BE ELIMINATED IF RT-11 SUPPORTS CTRL/Z AS EOF.
TST LOGTYP(R4)
BPL STRT8B ;NON FILE STRUCTURED
ADDRLO WDBLK5+12,R2
ADDRLO BATOBF-LOWSEG,R1 ;R1 -> OUTPUT BUFFER
CLR -(R2) ;WRITW
MOV #1000,-(R2) ;WC
MOV R1,-(R2) ;BUFFER
MOV #1000,R3 ;SET TO CLEAR OUTPUT BUFFER
1$: CLR (R1)+
DEC R3
BNE 1$
CLR -(R2) ;START AT BLOCK 0
MOV R2,R1 ;COPY PTR TO BLOCK #
MOV #11*400,-(R2) ;WRITE CHANNEL
MOVB DEFCHN+1(R4),(R2) ;SET IN THE CHANNEL NUMBER
2$: MOV R2,R0 ;COPY ARG. LIST POINTER
EMT 375 ;.WRITE WITH WAIT
INC @R1 ;BUMP BLOCK #
INC @R1
BCC 2$ ;KEEP WRITING UNTIL EOF
TSTB @#ERRWRD ;ERROR OR EOF?
BNE LOGERR ;ERROR ON WRITE
BR START8 ;EOF, WE'RE DONE
ENTRLO FTLPC,0 ;SAVE AREA FOR PC OF FATAL ERROR
BATFTL: MOV R0,FTLPC(R4)
SERROR
.EXIT
.SBTTL ENTER OUTPUT FILES
; ENTER IS A SUBROUTINE CALLED TO ENTER OUTPUT FILES
; FOR THE BATCH COMPILER. CALLING SEQUENCE AND ARG. LIST IS:
; JSR R5,ENTER
; OFFSET TO FILE NAME
; DEFAULT EXTENSION
; DEFAULT DEVICE
;
; R0,R1 ARE DESTROYED.
.ENABL LSB
ENTER: MOV (R5)+,R1 ;GET OFFSET
ADD R4,R1 ;R1 -> FILE NAME
MOV (R5)+,R3 ;R3 = DEFAULT EXTENSION
MOV (R5)+,R0 ;R0 = DEFAULT DEVICE
TST (R1)+ ;BRANCH IF DEVICE WAS SPECIFIED
BNE 1$
MOV R0,-2(R1) ;NO, SO USE DEFAULT DEVICE
1$: TST @R1 ;WAS FILE NAME SPECIFIED?
BEQ 2$ ;BR IF NOT, USE INPUT FILE NAME
CMP (R1)+,(R1)+ ;POINT TO EXTENSION
BR 4$
2$: ADDRLO SPC3+2,R0 ;R0 -> INPUT FILE NAME
TST (R0) ;BRANCH IF INPUT FILE EXISTS
BNE 3$ ;AND USE THAT AS OUTPUT NAME,
ADDR TMPSPC,R0 ;ELSE USE THE TEMPORARY NAME.
3$: MOV (R0)+,(R1)+ ;TRANSFER NAME
MOV (R0)+,(R1)+
4$: TST (R1)+ ;WAS EXT SPECIFIED?
BNE 5$ ;YES, USE IT
MOV R3,-2(R1) ;NO, USE DEFAULT
5$: ADDRLO WDBLK5+6,R0
CLR (R0) ;LAST WD IS 0(CT,MT ONLY)
MOV (R1),-(R0) ;SIZE
SUB #10,R1 ;FIX IT UP
MOV R1,-(R0) ;POINTER TO DEVBLK
MOV #2*400,-(R0) ;ENTER
MOVB (R2),(R0) ;SET IN THE CHANNEL NUMBER
EMT 375 ;.ENTER
BCS 6$
RTS R5
6$: TSTB @#52
BEQ 7$ ;CHANNEL IN USE
SERROR >>
2$: JSR PC,COPPRI
BR COPLUP
COMMAND PRINT SWITCH,DELETE
JSR PC,SVRPIP
3$: GETFD PRI NULL,INPUT
DATOUT LSTIT,<<>>
DATOUT STARX,<<<*.*/X>>>
JSR PC,COPPRI
BR 3$
COMMAND DELETE
JSR PC,SVRPIP
4$: GETFD DEL NULL
JSR PC,COPRDE
BR 4$
.DSABL LSB
SVRPIP: BIS #STAROK,BATSW2(R4)
COMOUT RPIP
RTSPC: RTS PC
.ENABL LSB
COPPRI: CHROUT #'=
DIRDIR: FINDFD COP NULL,INPUT
BNE 1$
TSTB COMSWT(R4) ;$DIR?
BPL NOFILE ;NO, GENERATE AN ERROR
1$: OUTFDC
TSTB COMSWT(R4)
BPL 25$
DATOUT SLASHL,<<>>
25$: CR.LF
FOUT
DATOUT
BIT #BITDEL,COMSWT(R4)
BEQ COMCHK
COPRDE: FINDFD COP NULL,INPUT
CLR R5
3$: OUTFD
BEQ 4$
COM R5
4$: DATOUT SLASHD
TST R5
BEQ 3$
COMCHK: BIT #COMMA,(R4)
BNE RTSPC
BIC #STAROK,BATSW2(R4)
JMP COMPIL
.DSABL LSB
NXTRT1: CR.LF
COMMAND RT11
JSR PC,GETIMM
CMPB #'$,(R0) ;IS FIRST CHARACTER A DOLLAR?
BNE DEFRT1
JMP LINE2
DEFRT1: CMPB #'*,(R0)
BNE TRYDOT
DATOUT NULINE
DOTGOT: INC R0
DATGOT: MOVB (R0)+,R3
BEQ NXTRT11
CMP #'',R3
BEQ 2$
3$: CHROUT
BR DATGOT
2$: MOVB (R0)+,R3
BEQ RTERR
CMP #'',R3
BEQ 3$ ;DOUBLE "'"
CMP #'",R3
BEQ QOTMES
DEC R0
SCAN CTY,
BR QCTY
SCAN FF,
BR QFF
SCAN LF,
BR QLF
CHECK (R0)
BLE RTERR
KOUT NULINE
; JSR R5,QERRQ
; BR QERROR
CHROUT (R0)+
QERROR: CHROUT #'2
CLOSQT: CMPB #'',(R0)+
BEQ DATGOT
RTERR: JSR PC,BADIF
BC$RT1: BR C$$RT1
QCTY: SAVE R3
JSR PC,QMBEL ;OUTPUT A ?,BELL,\G
RESTOR R3
BR SKIPQT ;SKIP OVER TO THE QUOTE
QLF: MOV R3,R0 ;CHROUT DESTROYS R3
CHROUT #NL
BR CLOSQT
QFF: FOUT
DATOUT
SKIPQT: MOV R3,R0 ;SCAN LEFT R3 POINTING JUST RIGHT
BR CLOSQT ;MUST BE FOLLOWED BY A CLOSE '
QOTMES: MESOUT
BR 2$
1$: CHROUT
2$: MOVB (R0)+,R3
BEQ RTERR
CMP #'",R3
BNE 1$
LOGOUT
DATOUT
BR CLOSQT
TRYDOT: CMPB #'.,(R0)
BNE NOTDOT
COMOUT NULINE
BR DOTGOT
NOTDOT: JSR PC,ALPNUM
BEQ NOLABL
CMP #':,R2
BNRTER: BNE RTERR
MOVB #200,-(R0)
LABLOW LINIMM
MOVB #':,(R0)+
1$: CMP #6,R1
BLE NOLABL
CHROUT #SPC
INC R1
BR 1$
NOLABL: LOGLOW LINIMM
JSR PC,EDIT
NOLAB: TSTB (R0)
BEQ BC$RT1
CMPB #40,(R0)+
BEQ 1$
DEC R0
1$: MOV #'0,-(SP)
SCAN NOTTY,
BR CNOTTY
SCAN TTYIO,
BR CTTYIO
SCAN TTYIN,
BR CTTYIN
SCAN TTYOUT,
BR CTTOUT
TST (SP)+
SCAN IF,
BR CIF
SCAN GOTO,
BR CGOTO
SCAN LET,
BR CLET
CMPB #'%,(R0)
BNE BNRTERR ;IMPLIED LET IS AN ERROR
BMPVAR: INC R0
JSR R5,LETINC
.WORD '0
BR NOLAB
CLET: MOV R3,R0
CLETIM: JSR R5,LETINC
.WORD '1
SPACES
CMPB #'=,(R0)+
BNE BNRTERR
JSR PC,ARGOUT
BR NOLAB
CGOTO: MOV R3,R0
JOUT
JSR PC,GETLAB
BR NOLAB
LETINC: SPACES
KOUT
; JSR R5,QERRQ
; BR 1$
CHECK (R0)+
BLE BADVAR
CHROUT R2
1$: CHROUT (R5)
R5POP: TST (R5)+
RTS R5
;QERRQ: SCAN IFERROR
; BR 2$
; BR R5POP
;2$: MOV R3,R0
; CHROUT <#'@>
; RTS R5
BADVAR: ERROR
TST (R5)+
RTS R5
CTTYIN: INC (SP)
CNOTTY: INC (SP)
CTTYIO: INC (SP)
CTTOUT: MOV R3,R0
HOUT
CHROUT (SP)+
BRNOLA: BR NOLAB
CIF: MOV R3,R0
JSR PC,IF$
JC$RT1: JMP C$$RT1
.ENABL LSB
IF$: SPACES
CMPB (R0)+,#'(
BNE BADIF
SPACES
; SCAN IFERROR,
; BR IF.AT
CHECK (R0)+
BGT 1$ ;A-Z
BADIF: ERROR
RTS PC
BADIF2: TST (SP)+
BR BADIF
;IF.AT: MOV #'@,R2
; MOV R3,R0
1$: SAVE R2
IOUT
CHROUT (SP)+
SPACES
CMPB #'-,(R0)+
BNE 3$ ;NO MINUS SIGN?
JSR PC,ARGOUT
BR 4$
3$: CLR R3
CHROUT R3 ;COMPAIR WITH 0
DEC R0
4$: SPACES
CMPB #'),(R0)+
BNE BADIF
JSR PC,GETLAB
BEQ 6$
CMPB #',,(R0)+
BNE BADIF
6$: JSR PC,GETLAB
BEQ 7$
CMPB #',,(R0)+
BNE BADIF2
7$: JSR PC,GETLAB
LABOUT SPACE6
BR BRNOLAB
.DSABL LSB
.CSECT ERRLST
SPACE6: .ASCII " "<200>
.CSECT PROGRM
ARGOUT: SPACES
CHECK (R0)+
BNE 5$
CLR -(SP)
2$: SUB #60,R2
CMP #10,R2
BLE BADIF2
ASL (SP)
ASL (SP)
ASL (SP)
ADD R2,(SP)
CHECK (R0)+
BEQ 2$
3$: DEC R0
4$: CHROUT (SP)+
RTS PC
5$: CMP #'",R2
BNE BADIF
MOVB (R0)+,-(SP)
BR 4$
.DSABL LSB
GETLAB: SPACES
MOV #'0,-(SP)
CMPB #'-,(R0)
BEQ 1$
INC (SP)
CMPB #'+,(R0)
BNE 2$
1$: INC R0
2$: MOV #6,-(SP)
3$: CHECK (R0)+
BLT 5$
CHROUT R2
DEC (SP)
BGT 3$
4$: CHECK (R0)+
BGE 4$
45$: TST (SP)+
CHROUT (SP)+
MOVB -(R0),R2
RTS PC
5$: CHROUT #40
DEC (SP)
BGT 5$
BR 45$
SPACE$: CMPB #40,(R0)
BNE 1$
INC R0
1$: RTS PC
COMMAND MOUNT SWITCH,WAIT,WRITE
DEFAULT SWITCH WAIT
COMOUT ;IN CASE OF UNEXPECTED .EXIT
MESLOW LINIMM
GETFD MOU LOGICAL,PHYSICAL,VID
EXCLUSIVE MOU NULL,PHYSICAL
FINDFD MOU LOGICAL
BEQ MOUQUS
COMOUT ASSPAC,<<>>
FINDFD MOU NULL,PHYSICAL,VID
JSR R5,MOUSUB
BR NOPHDV
JSR PC,QUSBEL
CHROUT #40
FINDFD MOU LOGICAL
JSR R5,MOUSUB
BR NOLODV
CR.LF
BR JMCOMP
COMMAND DISMOUNT SWITCH,WAIT
DEFAULT SWITCH WAIT
COMOUT ;IN CASE OF UNEXPECTED .EXIT
MESLOW LINIMM
GETFD DIS LOGICAL
EXCLUSIVE DIS NULL,LOGICAL
COMOUT RBATCH
FINDFD DIS NULL,LOGICAL
SAVE R2 ;(SAVE FOR DE-ASSIGN)
JSR R5,MOUSUB
BR NOLODV
CHROUT R2
DATOUT SLASHD
COMOUT ASSPAC
CHROUT #':
RESTOR R2
JSR R5,MOUSUB
BR NOLODV ;THIS SHOULD NEVER HAPPEN (BUT IT IS BETTER THAN A HALT)
CR.LF
BR MOUQUS
MOUSUB: BEQ 3$
MOV R2,R0
1$: CHECK (R0)+
BMI 2$
CHROUT R2
BR 1$
2$: CMP #':,R2
BNE 3$
TST (R5)+
3$: RTS R5
NOPHDV: ERROR
BR JMCOMP
NOLODV: ERROR
BR JMCOMP
COMMAND MESSAGE SWITCHES,WAIT
MESOUT
MOV R0,R2
JSR PC,OUTPUL
MOUQUS: JSR PC,QUSBEL
JMCOMP: JMP COMPIL
QUSBEL: BIT #BITWAI,COMSWT(R4)
BEQ OTFDRT
QMBEL: MESOUT
CHROUT #'?
CHROUT #7
GOUT
OTFDRT: RTS PC
COMMAND CHAIN
JSR PC,CHNCAL
CR.LF
JSR PC,COMCHK
BR C$$CHA
COMMAND CALL
JSR PC,CHNCAL
DATOUT SLASHS,,CR
JSR PC,COMCHK
BR C$$CAL
CHNCAL: FOUT
COMOUT RBATCH,<<>>,CR
GETFD CHA INPUT
FINDFD CHA NULL,INPUT
OTFDC$: OUTFD
BNE OTFDRT
CHROUT <<#',>>
BR OTFDC$
; THESE SWITCHES MAY APPEAR ONLY ON THE $JOB CARD, HENCE
; THEY APPLY TO THE ENTIRE JOB. SETCLR SETS OR CLEARS THE
; BIT AS SPECIFIED BY THE $JOB CARD.
SWITCH UNIQUE
JSR R5,SETCLR
.WORD BITUNI
.WORD UNIQUE
SWITCH TIME
JSR R5,SETCLR
.WORD BITTIM
.WORD TIME
SWITCH RT11
JSR R5,SETCLR
.WORD BITRT1
.WORD RT11
SWITCH BANNER
JSR R5,SETCLR
.WORD BITBAN
.WORD BANNER
SETCLR: BIT (R5)+,TMPSWT(R4)
BEQ 1$
BIS (R5),(R4)
BR 2$
1$: BIC (R5),(R4)
2$: RESTOR R5
BR NXTSWT
.SBTTL CHRCHK SUBROUTINE
; TESTS A CHARACTER POINTED TO BY R3
;TO SEE IF IT IS IN THE RANGE A-Z,0-9, OR OTHER
;RETURNS CONDITIONS + IF A-Z, 0 IF 0-9, - IF OTHER
;CHRCK COMPARE CHARACTER IN R2 FOR THE ABOVE
;CALL: JSR PC,CHRCHK (OR CHRCK)
; (RETURN WITH CONDITIONS SET)
;USES R2
CHRCHK: MOVB (R3),R2
CHRCK: CMPB #'Z,R2
BLT 1$ ;NOT A-Z OR 0-9 RETURN LT
CMPB R2,#'@
BGT 1$ ;A-Z RETURN GT
CMPB #'9,R2
BLT 1$ ;NOT A-Z,0-9 LT
CMPB R2,#'0
BLT 1$ ;DITTO
SEZ ;0-9 RETURN 0
1$: RTS PC
.ENABL LSB
SWITCH VID
CMPB #'=,(R0)+
BNE 2$
CMPB #'",(R0)+
BNE 3$
1$: MOVB (R0)+,R2
BEQ 2$
CMP #'",R2
BNE 1$
BR NXTSWT
3$: JSR PC,ALPNUM
BNE 4$
2$: ERROR
4$: DEC R0
BR NXTSWT
.DSABL LSB
SWITCH LIST
BIT #NO,(R4)
BEQ NXTSWT
BIS #LSTBIT,BATSW2(R4)
BR NXTSWT
.SBTTL SWTCHK SUBROUTINE
; RETURNS A BIT MAP OF SWITCHES IN TMPSWT
.ENABL LSB
;ENTER WITH R0 POINTING AT POSSIBLE SWITCH, AND R1 POINTING TO ACCEPTABEL SWITCHES
;CALL: JSR PC,SWTCHK
SWTCHK: SAVE R3,R5,R1 ;R1 POINTS TO LIST OF SWITCH NUMBERS
BIC #NO,(R4) ;SOME SWITCHES CAN'T TAKE ON A NO VALUE
SWITCH BASIC
SWITCH CREATE
SWITCH FORTRAN
SWITCH INPUT
SWITCH LIBRARY
SWITCH LOGICAL
SWITCH MACRO
SWITCH NULL
SWITCH PHYSICAL
SWITCH SOURCE
BIT #NO,(R4)
BNE BADSW1 ;THESE SWITCHES CANNOT HAVE 'NO' VALUES
SWITCH DATA
SWITCH DELETE
SWITCH DOLLAR
SWITCH EXECUTE
SWITCH MAP
SWITCH OBJECT
SWITCH OUTPUT
SWITCH RUN
SWITCH WAIT
SWITCH WRITE
NXTSWT: CMPB #'/,(R0)
BNE NOSWT ;NONE OR NO MORE SWITCHES
NXTSW2: INC R0 ;POINT TO FIRST CHARACTER OF SWITCH
MOV R0,R3 ;R3 AS TEMPORARY CURSOR
BIC #NO,(R4)
CMPB #'N,(R3)+
BNE 6$
CMPB #'O,(R3)+
BNE 6$ ;NO "NO"SWITCH
BIT #COMSWB,BATSW2(R4)
BEQ BADSW1 ;'NO' ONLY IN COMMAND FIELDS
MOV R3,R0
BIS #NO,(R4) ;SET THE "NO"SWITCH
6$: ADDR SWIT,R1
CLR R5 ;COUNTER OF VALID SWITCH NUMBER
CLR -(SP) ;UNIQUENESS FLAG
1$: DEC R5 ;SWITCH NUMBERS ARE NEGATIVE
2$: MOVB (R1)+,R2 ;FIRST CHARACTER OF SWITCH IS MINUS
BGT 2$ ;NOT FIRST CHARACTER
BEQ UNKSWT ;UNKNOWN SWITCH OR END OF TABLE
NEG R2
MOV R0,R3
CMPB (R3)+,R2
BNE 1$
JSR R5,SCAN2 ;LET SCAN DO THE REST
BR 3$ ;MADE SOME KIND OF MATCH
BR 1$ ;NO MATCH
3$: BGE BADSWT ;EXTRA CHARACTERS AT END OF MATCH
TST (SP) ;UNIQUE?
BNE NOUNIQ
MOV R5,(SP)
SAVE R3
BR 1$
NOUNIQ: MOV (SP)+,R0
TST (SP)+ ;PRUNE STACK
ERROR
BR NXTSWT
4$: CLC
ROR R3 ;NEXT
5$: MOVB (R1)+,R2 ;ANOTHER VALID SWITCH?
BGE BADSW1 ;NO, BAD SWITCH
CMP R2,R5
BNE 4$ ;NOT THIS ONE
BIT #NO,(R4)
BEQ 10$
BIC R3,TMPSWT(R4)
BR 11$
10$: BIS R3,TMPSWT(R4) ;FOUND IT, SET IN THE CORESPONDING BIT
11$: ADDR SWTADD,R3 ;ADDRESS OF SWITCH JUMP TABLE
COM R5
ASL R5
ADD R3,R5 ;POINT TO SWITCH JUMP DISPLACEMENT TABLE
.IF NE PIC
MOV (R5),R5 ;WHEN GLOBAL ARITHMETIC COMES IN DO A ADD (R5),R5
SWTJMP: ADD PC,R5 ;JUMP ADDRESS IN R5
JMP @R5
.IFF
JMP @(R5)
.ENDC
;*********************************
UNKSWT: MOV (SP)+,R3
BEQ BADSW1
8$: MOV R3,R0 ;UPDATE THE CURSOR
MOV (SP)+,R5
MOV #100000,R3 ;SET UP SWITCH BIT
MOV (SP),R1 ;ACCEPTABLE SWITCH TABLE
BR 5$
BADSWT: TST (SP)+
BADSW1: ERROR
BADSW2: CMPB #'/,(R0)
BEQ NXTSW2
TSTB (R0)
BEQ NOSWT2 ;EOL
CMPB #40,(R0)
BEQ NOSWT2
INC R0 ;POINT TO NEXT SWITCH
BR BADSW2
NOSWT: TST TMPSWT(R4)
BNE 9$
MOV #100000,TMPSWT(R4)
9$: MOVB (R0),R3
ISIT SPCCR,NOSWT2,<" ,+">
ERROR
NOSWT2: BIT #COMSWB,BATSW2(R4)
BEQ 7$
MOV TMPSWT(R4),COMSWT(R4)
7$: RESTOR R3,R5,R1
RTS PC
.DSABL LSB
ERRLOG: SAVE R0,R3
BIS #ABORT,(R4) ;SET ABORT SWITCH
LOGOUT CRLF
LOGLOW LINIMM
ADDRLO LINIMM,R2
SUB R2,R0 ;CHARACTER NUMBER AT ERROR
1$: DEC R0
BMI 2$
CHROUT #40
BR 1$
2$: CHROUT #'^
CR.LF
JSR PC,OUTPU5 ;OUT PUT THE MESSAGE
RESTOR R0,R3
RTS R5
.SBTTL ISIT SUBROUTINE
; TEST FOR ONE OF A LIST
ISIT$: SAVE R1
MOV (R5)+,R1
.IF NE PIC
ADD R5,R1 ;POINTER TO LIST
.ENDC
1$: CMPB (R1),R3 ;R3 IS CHARACTER IN QUESTION
BEQ 3$ ;FOUND A MATCH
TSTB (R1)+ ;CHECK FOR EOL
BNE 1$
TST (R5)+ ;BUMP OVER FOUND ADDRESS
2$: RESTOR R1
RTS R5
3$: .IF EQ PIC
MOV (R5),R5
.IFF
ADD (R5),R5 ;SET TO FOUND TRANSFER ADDRESS
.ENDC
BR 2$
.ENABL LSB
COMMAND DATA SWITCH,DOLLAR,LIST
JSR PC,TSTDOL ;TEST FOR /DOLLAR
SAVE BATSW2(R4) ;SAVE SWITCH WORD
JSR PC,TSTLST ;WAS /LIST REQUESTED?
JSR PC,DATMAK
BR 1$
COMMAND CREATE SWITCH,DOLLAR,LIST
GETFD CRE OUTPUT
EXCLUSIVE CRE NULL,OUTPUT
COMOUT RBATCH
FINDFD CRE NULL,OUTPUT
BEQ CREERR
JSR PC,TSTDOL ;TEST FOR /DOLLAR
SAVE BATSW2(R4) ;PRESERVE SWITCH VALUE
JSR PC,TSTLST ;WAS /LIST REQUESTED?
JSR PC,SOUMAK
COMOUT
1$: RESTOR BATSW2(R4) ;RESTORE PREVIOUS SWITCH VALUE
CLR -(SP) ;COUNTER (CHECK COMPIL:)
JMP LINE2B
.DSABL LSB
ERRCRE: JSR PC,MAKBA2 ;SWITCH LINIMS WITH LINIMM
CREERR: JMP NOFILE
.ENABL LSB
SOUMAK: OUTFD
DATOUT BATCRE,<<>>,CR
DATMAK: MOV PC,-(SP) ;NON ZERO SWITCH ON STACK
BIT #LSTDAT,BATSW2(R4)
BEQ 1$
5$: HOUT
CHROUT #'1 ;TTYIO
1$: JSR PC,GETIMM
CMPB #'$,(R0)
BEQ 2$
10$: DATLOW LINIMM
CLR (SP) ;CLEAR OUTPUT FLAG
BR 1$
2$: BIT #DATDOL,(R4)
BEQ 4$
INC R0
SCAN CN$EOD
BR 3$
SCAN CN$EOJ
BR 3$
SCAN CN$JOB
BR 3$
SCAN CN$SEQ
BR 3$
BR 10$
3$: ADDRLO LINIMM,R0
4$: CHROUT #CTRL.Z
BIT #LSTDAT,BATSW2(R4)
BEQ 7$
HOUT
CHROUT #'0
7$: BIC #DATDOL,(R4)
TST (SP)+
BNE ERRCRE ;NO DATA FOLLOWED??
RTS PC
.DSABL LSB
MAKSOU: JSR PC,MAKMAK
COMOUT RBATCH
LSTSOU
JSR PC,SOUMAK
MAKBA2: ADDRLO LINIMS,R1
MOV #LINSZ/2,R2
2$: MOV (R0),R3
MOV (R1),(R0)+
MOV R3,(R1)+
DEC R2
BNE 2$
RTS PC
MAKMAK: BIS #MAKE,(R4)
ADDRLO LINIMM,R0
ADDRLO LINIMS,R1
MOV #LINSZ/2,R2
1$: MOV (R0)+,(R1)+
DEC R2
BNE 1$
RTS PC
MAKBAS: JSR PC,MAKMAK
JSR PC,DATMAK
BR MAKBA2
TSTDOL: BIT #BITDOL,COMSWT(R4) ;A /DOLLAR SW. ON THIS CMD?
BEQ 1$ ;BRANCH IF NOT
BIS #DATDOL,(R4) ;YES, SET IN BATSWT
1$: RTS PC
TSTLST: BIT #BITLIS,COMSWT(R4) ;WAS /LIST SET ON COMMAND
BEQ 1$
BIS #LSTDAT,BATSW2(R4);SET IN BATSW2
1$: RTS PC
;$LINK, $MACRO & $FORTRAN ARE SO SIMILAR THAT A COMMON ROUTINE IS USED.
;IT IS VERY IMPORTANT THAT THE ORDER OF THEIR SWITCHES BE IDENTICAL
;WITH EXCEPTION OF THE MACRO SWITCH
COMMAND MACRO SWITCHES,RUN,MAP,OBJECT,LIBRARY,DATA,DOLLARS,LIST,CREF
SAVE COMSWT(R4)
BIT #BITLIB,(SP)
BEQ C$MACR
BIS #BFORLIB,(R4)
C$MACR: BIS #1,(SP) ;SET IN $MACRO FLAG
GETFD MAC INPUT,EXECUTE,OBJECT,OUTPUT,MAP,LIBRARY,LIST,MACRO,SOURCE
EXCLUSIVE MAC INPUT,MACRO,SOURCE
EXCLUSIVE MAC OUTPUT,OBJECT
BR FORMAC
COMMAND LINK SWITCHES,RUN,MAP,OBJECT,LIBRARY
DEFAULT SWITCH,OBJECT
SAVE COMSWT(R4)
BIT #BITLIB,(SP)
BEQ 1$
BIS #BFORLIB,(R4)
1$: BIS #2,(SP)
C$LINK: GETFD LIN INPUT,EXECUTE,OBJECT,OUTPUT,MAP,LIBRARY
EXCLUSIVE LIN INPUT,OBJECT
EXCLUSIVE LIN EXECUTE,OUTPUT
BR C$LNK
;NOTE SECOND OBJECT IS A DUMMY FILL FOR LIBRARY IN $LINK AND $MACRO
COMMAND FORTRAN SWITCHES,RUN,MAP,OBJECT,LIBRARY,DATA,DOLLARS,LIST
SAVE COMSWT(R4)
C$FORT: GETFD FOR INPUT,EXECUTE,OBJECT,OUTPUT,MAP,LIBRARY,LIST,FORTRAN,SOURCE
EXCLUSIVE FOR INPUT,FORTRAN,SOURCE
EXCLUSIVE FOR OUTPUT,OBJECT
FORMAC: FINDFD FOR NULL,INPUT,SOURCE,FORTRAN
BIT #BITDOL,COMSWT(R4) ;A /DOLLAR SW. ON THIS CMD?
BEQ 1$ ;BRANCH IF NOT
BIS #DATDOL,(R4) ;YES, SET IN BATSWT
1$: MOV R2,COMSWT(R4) ;TEMPORARY POINTER TO INPUT FD
BNE 4$
JSR PC,MAKSOU
4$: BIT #1,(SP)
.ENABL LSB
BEQ 6$ ;IF $FORTRAN
COMOUT RMACRO,<<>>,CR
BR 8$
6$: COMOUT RFORT,<<>>,CR
8$: FINDFD FOR OBJECT,OUTPUT
BNE 12$
BIT #BITRUN+BITOBJ+BITMAP,(SP)
BNE 10$
FINDFD FOR EXE,MAP
BEQ 16$ ;NO OBJECT
10$: GETOBJ ;GET A TEMPORARY OBJECT FILE
OUTFD.
BR 14$
12$: OUTFD
BEQ BBDFOR ;'+' IN OBJECT LIST?
14$: BIT #1,(SP)
BNE 16$ ;IF $MACRO DON'T SET FORLIB REQUEST
BIS #BFORLIB,(R4)
16$: FINDFD FOR LIST
BNE 18$
BIT #BITLIS+BITCRE,(SP) ;IS LIST SWITCH ON?
BEQ 20$
GETLST
BR 20$
18$: JSR PC,COUTFD
BEQ BBDFOR
20$: DATOUT EQUALS,<<<=>>>
.DSABL LSB
.ENABL LSB
MOV COMSWT(R4),R2 ;FINDFD FOR FORTRAN,NULL,SOURCE,INPUT
BNE 22$
LSTSOU ;GET A SOURCE TEMPORARY
22$: OUTFDC
BIT #BITCRE,(SP)
BEQ 24$
DATOUT SLSHC,<<>>
24$: CR.LF
BIT #1,(SP) ;IF $MACRO
BNE 25$ ;FLUSH BUFFER OF MACRO MESG.
BIT #BITLIS+BITCRE,(SP) ;DO FOR $FOR ONLY IF LISTING
BEQ 26$
25$: FOUT ;FLUSH LOG BUFFER
DATOUT ;KEEP FROM ABORTING
26$: BIT #MAKE,(R4)
BEQ 28$
COMOUT RPIP
LSTSOU
OUTFD
DATOUT SLASHD
28$: FINDFD FOR EXECUTE,MAP
BNE C$LNK
BIT #BITRUN+BITMAP,(SP)
BNE C$LNK
JMP FOREND
C$LNK: COMOUT RLINK,<<>>,CR
FINDFD FOR EXECUTE
BNE 32$
BIT #2,(SP)
BEQ 30$
FINDFD LIN OUTPUT,EXECUTE
BNE 32$
30$: BIT #BITRUN,(SP)
BEQ 33$
GETSAV
OUTFD.
BR 33$
32$: DATOUT
OUTFD
BEQ BBDFOR
33$: FINDFD FOR MAP
.DSABL LSB
.ENABL LSB
BNE 34$
BIT #BITMAP,(SP)
BEQ 36$
GETLST
BR 36$
34$: JSR PC,COUTFD
BNE 36$
BBDFOR: JMP BADFLK
36$: CHROUT #'=
BIT #2,(SP) ;IS THIS A $LINK?
BEQ 37$ ;NO, THEN DON'T TEST /OBJ
BIT #BITOBJ,(SP) ;LINK IN TEMP OBJS?
BEQ 40$ ;NO,DON'T LINK THEM
37$: JSR PC,OBJCHK
BEQ 40$
38$: DMPOBJ <'C+100000>
TST R3 ;SEE IF CR.LF WAS LAST
BEQ 40$ ;YES
BIT #2,(SP)
BEQ 39$ ;BRANCH IF NOT $LINK
FINDFD LIN NULL,INPUT,OBJECT
BR .39$
39$: FINDFD FOR OBJ,OUT
.39$: BEQ 40$
CHROUT <<#',>>
40$: BIT #2,(SP)
BEQ 42$
FINDFD LIN NULL,INPUT,OBJECT
BEQ 46$
OUTFDC ;OUPUT MULTIPLE FD'S
BR 46$ ;THEN PROCESS LIBRARIES.
42$: FINDFD FOR OBJ,OUT
BEQ 46$
44$: OUTFD
46$: FINDFD FOR LIBRARY
JSR PC,NOUTFD
BIT #BFORLIB,(R4)
BEQ 56$
ADDRLO LIBLST,R2
TSTB (R2)
BEQ 56$
CLR R5
BR 52$
NOUTFD: BEQ 48$
COUTFD: CHROUT <<#',>>
OUTFD
48$: RTS PC
50$: DATOUT SLASHC,<<>>,CR
MOV #5,R5
BR 54$
52$: CHROUT <<#',>>
54$: OUTFD
BNE 56$
DEC R5
BLE 50$
BR 52$
56$: CR.LF
BIT #2,(SP) ;SKIP TEST OF BITOBJ IF
BEQ 57$ ; THIS IS A $LINK
BIT #BITOBJ,(SP) ;TEST FOR /NOOBJ SWITCH
BEQ 60$ ;DON'T DELETE TEMP. OBJ'S IF SET
57$: JSR PC,OBJCHK
BEQ 60$
COMOUT RPIP,<<>>,CR
DMPOBJ <'D>
TST R3 ;SEE IF CR.LF WAS LAST
BEQ 58$ ;YES
DATOUT SLASHD,,CR
58$: MOV #"0/,OBJTMP+4(R4)
MOVB #'0,OBJTMP+3(R4)
60$: BIC #BFORLIB,(R4)
BIT #BITRUN,(SP)
.DSABL LSB
BEFREN: BEQ FOREND
.ENABL LSB
COMOUT RSPACE,<<>>
FINDFD FOR EXE
BNE 62$
GETSAV
OUTFD.
BR 64$
62$: OUTFD
BADFLK: BEQ BADFOR
64$: CR.LF
FINDFD FOR EXE
BNE FOREND
COMOUT RPIP
GETSAV
OUTFD
DATOUT SLASHD
BR FOREND
.DSABL LSB
BADFOR: JSR PC,BADPLU
FOREND: JSR PC,COMCHK
BIT #1,(SP)
BEQ 2$
JMP C$MACR
2$: BIT #2,(SP)
BEQ 3$
JMP C$LINK
3$: JMP C$FORT
;*** YOU WILL NOTE THAT THE LIST SWITCH IS IN POSITION #2
;*** IT MUST BE IN THE SAME POSITION AS THE LIST SWITCH IN $DATA...
COMMAND BASIC SWITCHES,RUN,LIST
MORBAS: GETFD BAS BASIC,SOURCE,INPUT
EXCLUSIVE BAS NULL,BASIC,SOURCE,INPUT
COMOUT RBASIC,<<>>,CR
CR.LF
FINDFD BAS NULL,BASIC,SOURCE,INPUT
BNE GOTBAS
DATOUT SCRATCH,<<>>,CR
SAVE BATSW2(R4)
JSR PC,TSTLST ;WAS /LIST REQUESTED?
1$: JSR PC,MAKBAS
RESTOR BATSW2(R4)
BR RUNBAS
GOTBAS: DATOUT OLD,<<>>,CR
OUTFD
BEQ BASERR
CR.LF
RUNBAS: BIT #BITRUN,COMSWT(R4)
BEQ NORUNB
DATOUT RUNCR,<<>>,CR
NORUNB: JSR PC,COMCHK
BR MORBAS
BASERR: JSR PC,BADPLU
BR NORUNB
.ENABL LSB
COMMAND LIBRARY
GETFD LIB
ADDRLO LIBLST,R5
CLRB (R5)
FINDFD LIB NULL
BEQ 2$
1$: MOVB (R2)+,(R5)+
BNE 1$
2$: JSR PC,COMCHK
ERROR
JMP COMPIL
FDFIND: ADDRLO FD0,R3
3$: MOV (R3)+,R2
BEQ 4$
BIT (R3)+,(R5)
BEQ 3$
4$: TST (R5)+
TST R2
RTS R5
;I COULD PUT IN A CHECK TO BE SURE THAT WE DON'T GO OVER NNN999.OBJ?
OBJSOU: MOV (R5),R2
ADD R4,R2 ;POINT TO NAME TO BUMP
ADD #5,R2 ;LAST CHAR
5$: INCB (R2)
CMPB #'9,(R2)
BGE 6$
MOVB #'0,(R2)
DEC R2
BR 5$
6$: MOV (R5)+,R2
ADD R4,R2 ;LEAVE WITH R2 POINTING TO NAME
RTS R5
LSTLST: CHROUT <<#',>>
SAVE R0
DATLOW LSTTMP
MOV #';-1,R0 ;EXTRA VARIABLES ARE ';','<','=','>','?'
7$: INC R0
GETVAR R0
CMP #'=,R0
BNE 7$
8$: INCVAR R0
IFOUT R0,#'9,IF$LST,<<>>
LABOUT IF$LST+16
INTVAR R0,#'0
DEC R0
CMP #';-1,R0
BNE 8$
LABOUT DUMMY$
DATOUT
RESTOR R0
RTS PC
.DSABL LSB
OBJDMP: ADDRLO OBJTMP+2,R2
SAVE (R2)+,(R2)
MOV #"0/,(R2)
MOVB #'0,-(R2)
CLR -(SP)
1$: GETOBJ
TST (SP)
BEQ 2$
CHROUT <<#',>>
2$: INC (SP)
TST (R5)
BPL 5$
OUTFD.
BR 6$
5$: OUTFD
6$: CMP #5,(SP)
BGT 3$
CHROUT #'/
CHROUT (R5)
CR.LF
CLR (SP)
3$: ADDRLO OBJTMP+2,R2
CMP (R2)+,4(SP)
BNE 1$
CMP (R2),2(SP)
BNE 1$
MOV (SP)+,R3 ;IF 0 CR.LF WAS LAST
RESTOR -(R2),(R2)
TST (R5)+
RTS R5
OBJCHK: ADDRLO OBJTMP+3,R2
MOVB (R2)+,R1
ADD (R2),R1
CMP #"0/+'0,R1
RTS PC
GETFD$: BIC #COMMA,(R4)
BIC #COMSWB,BATSW2(R4)
CLR SWTMSK(R4)
SAVE #5 ;HIGHEST FD NUMBER
ADDRLO FD0,R3
GETFD0: TSTB (R0) ;CHECK FOR NO ARGUMENTS
BNE GETFD4
GTFD15: CLR (R3) ;INDICATE NO FD
1$: TST (R5)+
BNE 1$
TST (SP)+
RTS R5
GTFD13: TST (R3)+
DEC (SP)
BMI TMFD ;TOO MANY FILE DESCRIPTORS
GETFD4: SPACES
MOV R0,(R3)+ ;POINTER TO FD GOES IN (R3)
CLR (R3) ;CLEAR OUT SWITCHES
JSR PC,NAMEXT
GETFD5: CMP #':,R2 ;CHECK FOR DEVICE
BNE GETFD7 ;NOT A DEVICE
JSR PC,NAMEXT ;SPAN FILE NAME
GETFD7: CMP #'.,R2 ;NAME ENDING WITH .?
BNE GETFD8
TST R1
BNE GETFD9
ERROR
GETFD9: JSR PC,NAMEXT
GETFD8: DEC R0
; PROCESS THE FILE DESCRIPTOR FIELD FOR SWITCHES.
MOV (R5),R1
.IIF NE PIC, ADD R5,R1
CLR TMPSWT(R4)
JSR PC,SWTCHK ;CHECK FOR SWITCHES, RETURNED IN TMPSWT
BIC #BITNUL,SWTMSK(R4)
BIS TMPSWT(R4),(R3) ;AND SWITCH INTO FD SLOT,
BIT (R3),SWTMSK(R4) ;THEN SEE IF ALREADY DEFINED.
BEQ GETFD1 ;BRANCH IF O.K.
ERROR
GETFD1: BIS (R3),SWTMSK(R4) ;AND INTO SWTMSK
SAVE R5
TST (R5)+
; TEST TO SEE IF TWO EXCLUSIVE SWITCHES, AS DEFINED BY THE EXCLUSIVE
; MACRO WHICH MUST FOLLOW THE MACRO (GETFD) WHICH INVOKES THIS CODE,
; HAVE BEEN SPECIFIED. THAT IS A SYNTAX ERROR.
1$: MOV (R5)+,R1
BEQ GETFD2
MOV SWTMSK(R4),R2
BIC R1,R2
BEQ 1$
2$: ASL R2
BCC 2$
BEQ 1$
ERROR
BIC (R3),SWTMSK(R4)
GETFD2: RESTOR R5
; CHECK FOR MULTIPLE FILE DESCRIPTIONS, I.E., USE OF '+' TO
; SPECIFY MULTIPLE INPUT FILES. IF MORE IS TO COME, THE NULL
; SWITCH MUST BE CLEARED TO AVOID A MULTIPLE SWITCH ERROR.
GTFD11: MOVB (R0)+,R2 ;END OF COMMAND?
BEQ GTFD14 ;BRANCH IF SO.
CMPB #'+,R2 ;CHECK TERMINATING CHAR
BNE GTFD12 ;BRANCH IF NOT '+'
BIC #BITNUL,SWTMSK(R4) ;CLEAR NULL SWITCH
JSR PC,ALPNUM ;GET FD AFTER +
BNE GETFD5 ;BRANCH IF ANOTHER FD EXISTS
JSR PC,BADPLU ;ELSE IT'S AN ERROR!
BR GTFD11
GTFD12: CMP #40,R2 ;SPACE?
BEQ GTFD13
CMP #',,R2 ;COMMA?
BNE GTFD16
BIS #COMMA,(R4)
GTFD14: TST (R3)+
BR GTFD15 ;ALL FD'S IN ORDER
GTFD19: TST (SP)+
GTFD16: ERROR
BR GETFD0
TMFD: ERROR
BR GTFD15
NAMEXT: JSR PC,ALPNUM ;SPAN DEVICE OR FILE NAME
BNE 1$
CMP #'*,R2
BNE 1$
BIT #STAROK,BATSW2(R4)
BEQ GTFD19
CHECK (R0)+
BPL GTFD19
CMP #':,R2
BEQ GTFD19
INC R1
1$: RTS PC
ENTRLO SWTMSK,0
ENTRLO FD0,0,0
ENTRLO FD1,0,0
ENTRLO FD2,0,0
ENTRLO FD3,0,0
ENTRLO FD4,0,0
ENTRLO FD5,0,0,0 ;EXTRA WORD FOR END FLAG
.ENABL LSB
OTFD.$: MOV #'.,-(SP)
BR 1$
OUTFD$: MOV PC,-(SP)
1$: DATOUT
BR 2$
OUTFDC: CHROUT
2$: MOVB (R2)+,R3
ISIT CMSPCR,OUTFDE,<", ">
CMP (SP),R3
BEQ 5$
CMP #'*,R3
BNE 3$
BIS #STARFD,BATSW2(R4)
3$: CMP #'+,R3
BEQ 5$
CMP #'/,R3
BNE OUTFDC
4$: ISIT CMSPCR,OUTFDE
MOVB (R2)+,R3
BR 4$
5$: CLR (SP)
OUTFDE: TST (SP)+
RTS PC
.DSABL LSB
; GETIMM GETS AN IMMAGE LINE
GETIM0: TSTB LINIMM(R4)
BNE GETIM3
GETIMM: ADDRLO LINIMM,R0
GETIM1: CLRB (R0)
GETIM2: JSR PC,GETCHR
ISIT LFFF,GETIM2,<<12><14>>
ISIT CR,GETIM0,<<15>>
MOVB R3,(R0)+
TSTB (R0) ;SEE IF LINE TOO LONG
BPL GETIM1
CLRB -(R0)
JSR PC,GETIM3 ;LOG THE LINE IMMAGE BUFFER
ERROR
BR GETIMM
GETIM3: ADDRLO LINIMM,R0
RTS PC
ALPNUM: CLR R1 ;CLEAR COUNTER
1$: MOVB (R0)+,R2
INC R1
JSR PC,CHRCK
BGE 1$
DEC R1
RTS PC
EDIT: SAVE R1,R2,R0 ;REMOVE COMMENTS
EDIT1: CLR R1
1$: MOVB (R0)+,R2
BEQ COMPRS
CMP #'",R2
BNE 2$
INC R1 ;BUMP QUOTE COUNTER
2$: CMP #'!,R2
BNE 1$
BIT #1,R1
BNE 1$
CLRB -(R0)
COMPRS: MOV (SP),R0 ;COMPRESS SPACES AND TABS
MOV R0,R1
1$: MOVB (R1)+,R2
BEQ 4$
CMP #40,R2
BEQ 2$
CMP #11,R2
BNE 3$
2$: CMPB #40,-1(R0) ;SPACE BEFORE
BEQ 1$
MOV #40,R2
3$: MOVB R2,(R0)+
BR 1$
4$: CMPB #'-,-(R0)
BNE 5$
CMPB #'$,@LINIMP(R4) ;ONLY ON $ LINES
BNE 5$
SAVE R0
JSR PC,GETIM1
RESTOR R0
LOGOUT ;MUST BE IN LOGOUT MODE
MOV R0,R2
JSR PC,OUTPUL
BR EDIT1
5$: CMPB #40,(R0) ;TRAILING SPACE MUST GO
BEQ 6$
INC R0
6$: CLRB (R0)
RESTOR R1,R2,R0
RTS PC
.GLOBL PATCH
PATCH: .REPT 100.
.WORD 0
.ENDR
.CSECT SERRLS ;MUST BE END OF LAST .CSECT
.EVEN
BATEND:
.END START
.TITLE RT-11 BATCH HANDLER V01-03
; RT-11 BATCH RESIDENT HANDLER
;
; JANUARY 75
; JD/DV
;
; COPYRIGHT (C) 1975
;
; DIGITAL EQUIPMENT CORPORATION
; MAYNARD, MASSACHUSETTS 01754
;
; THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY
; ON A SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH
; THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS
; SOFTWARE, OR ANY OTHER COPIES THEREOF, MAY NOT BE PROVIDED
; OR OTHERWISE MADE AVAILABLE TO ANY OTHER PERSON EXCEPT
; FOR USE ON SUCH SYSTEM AND TO ONE WHO AGREES TO THESE
; LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE SOFTWARE
; SHALL AT ALL TIMES REMAIN IN DIGITAL.
; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO
; CHANGE WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED
; AS A COMMITMENT BY DIGITAL EQUIPMENT CORPORATION.
; DIGITAL ASSUMES NO RESPONSIBILITY FOR ANY ERRORS THAT
; MAY APPEAR IN THIS SOFTWARE.
; DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE
; OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT
; WHICH IS NOT SUPPLIED BY DIGITAL.
;
.SBTTL CONTROL CHARACTER DEFINITIONS
; FILE GENERATED BY THE BATCH COMPILER (OR TECO IF YOU DESIRE)
; BATCH HAS SEVERAL CONTROLLING COMMANDS, THESE COMMANDS ARE NOT RELATED
; TO ANYTHING IN THE DEC BATCH STANDARD, ANY RESEMBLANCE IS PURELY
; COINCIDENTAL. THE BATCH COMPILER WILL TRANSLATE THE DEC BATCH STANDARD
; (LEVEL1) INTO RT-11 BATCH RUNTIME HANDLER FORMAT.
; ALL DIRECTIVES IN THE SPECIAL INPUT FORMAT ARE PRECEEDED BY A BACKSLASH.
; IF A BACKSLASH MUST BE PASSED TWO ADJACENT BACKSLASHES WILL PASS ONE.
; SINGLE CHARACTER DIRECTIVES:
; "\@" ROUTE THE FOLLOWING CHARACTERS TO THE CTY:
; "\A" CHANGE THE INPUT SOURCE TO THE CTY:
; "\B" CHANGE THE INPUT SOURCE TO THE BATCH STREAM
; "\C" ROUTE THE FOLLOWING CHARACTERS TO THE LOG
; "\D" THE FOLLOWING CHARACTERS ARE USER DATA
; "\E" THE FOLLOWING CHARACTERS ARE TO BE EXECUTED BY THE KMON.
; "\FN" N=0, FORCE THE JOB TO ABORT
; N=1, OUTPUT CURRENT LOG BUFFER AND EXIT
; "\G" GET FROM CTY EXCLUDING C.R.
; "\HN" HELP, N=0, LOG ONLY .TTYOUT, .PRINT
; N=1, LOG .TTYOUT, .PRINT, .TTYIN
; N=2, NO LOGGING OF .TTYOUT, .TTYIN, .PRINT
; N=3, LOG .TTYIN
; IN ALL CASES ABOVE ALL MESSAGES (\C) ARE NOT AFFECTED
; "\IVALEG" IF DIRECTIVE
; V=A-Z, VARIABLE FOR COMPARISON
; A=0-377, ARGUMENT FOR COMPARISON
; L,E,G=STRINGS OF SIX CHARACTERS PLUS A "0" OR "1" EACH
; TRANSFER WILL GO TO LABEL L IF THE EXPRESSION (R-V) IS <0
; IF THE CHARACTER FOLLOWING L="0" THEN THIS INDICATES
; THAT THE LABEL IS A BACKWARD REFERENCE. IF THE CHARACTER FOLLOWING
; L="1" THEN THIS INDICATES THAT THE LABEL IS A FOREWARD REFERENCE.
; E,G ARE LABELS TO GOTO FOR THE EXPRESSION (R-V) =,>0. THEY ARE ALSO
; FOLLOWED BY A "0" OR "1"
; "\JL" UNCONDITIONAL JUMP TO LABEL L
; "\KVF(D)" 'KONSTANT' V = VARIABLE (A-Z), F = FUNCTION
; F = 0, INCRIMENT VARIABLE V
; F = 1, MOVE DATA BYTE D INTO VARIABLE V
; F = 2, RETURN VALUE OF VARIABLE V TO .TTYIN CALL
; "\L" LABEL, NEXT SIX BYTES ARE A LABEL ANY MORE CHARACTERS ARE IGNORED.
; IF FB IS RUNNING .TTYIN,.TTYOUT,.PRINT AND .EXIT EMT'S
; WILL POINT TO FB$TIN,FB$TOT,FB$PRN AND FB$EXT. ON THE OTHER HAND
; IF YOU ARE RUNNING BACKGROUND ONLY THEY POINT TO B$TIN,B$TOT,
; B$PRN AND B$EXT. O$TIN,O$TOT,O$PRN AND O$EXT HAVE THE REAL
; POINTERS TO THE MONITOR EMT'S
.SBTTL DEFINITIONS
R0=%0
R1=%1
R2=%2
R3=%3
R4=%4
R5=%5
SP=%6
PC=%7
JSW= 44 ;JOB STATUS WORD
ERRWRD= 52 ;RT-11 ERROR WORD LOCATION
MONCOM= 356 ;MONITOR COMMUNICATION BYTE
SYSPTR= 54 ;POINTER TO SYSTEM
CONTXT= 320 ;POINTER IN FBMON TO JSTATE
COMREG= 7 ;COMMUNICATION REGISTER
EMT16= 316 ;DISPLACEMENT OFF OF 54 TO DISPLACEMENT OFF OF
;54 TO THE EMT 16 TABLE.
CONFIG= 300 ;DISPLACEMENT OFF OF 54 TO WORD WITH MONITOR TYPE
FBMON$= 1 ;BIT IN CONFIG THAT INDICATES F/B OR BG ONLY.
JOBNUM= 24 ;IF F/B IS RUNNING THIS IS THE DISPLACEMENT
;OFF OF R5 (IMPURE AREA) OF THE LOCATION WITH
;THE JOB NUMBER.
INBSIZ= 400 ;INPUT BUFFER SIZE
OUBSIZ= 400 ;OUTPUT BUFFER SIZE
BATSTK= 0 ;SIZE OF BATCH STACK. IF ZERO USE USERS STACK.
LABSIZ= 6 ;NUMBER OF CHARACTERS PER LABEL
TCBIT$= 100
.SBTTL MACRO DEFINITIONS
.MACRO ADDR ADDRESS,REG
MOV PC,REG
ADD #ADDRESS-.,REG
.ENDM
.MACRO LINK1 N,OLD ;LINK HANDLER TO MONITOR
MOV N*2(R1),R2
ADD R1,R2
ADDR OLD,R3
SUB R3,R2
MOV R2,OLD
.ENDM
.MACRO LINK2 N,LABLE ;LINK MONITOR TO HANDLER
ADDR LABLE,R3
SUB R1,R3
MOV R3,N*2(R1)
.ENDM
.IF NE BATSTK
.MACRO SAVSTK
MOV SP,SPSAVE
ADDR SPSAVE,R4
MOV R4,SP ;DON'T "ADDR SPSAVE,SP"*********
.ENDM
.MACRO RESSTK
MOV SPSAVE,SP
.ENDM
.ENDC
.MACRO SAVE,A0,A1,A2,A3,A4,A5
.IRP X,
.IIF NB ,MOV X,-(SP)
.ENDR
.ENDM
.MACRO RESTOR,A0,A1,A2,A3,A4,A5
.IRP X,
.IIF NB ,MOV (SP)+,X
.ENDR
.ENDM
.CSECT BATHND
HSIZE= BATEND-.
DVSIZ= 0
PNAME= 'B-100*50+'A-100*50+0 ;.RAD50 /BA /
STAT= 4
LOADPT:
.WORD 0 ;NO INTERRUPT VECTOR
.WORD BAINTR-.+2 ;ABORT ENTRY POINT
.WORD 0 ;NO PRIORITY
BALQE: .WORD 0 ;NO QUEUE
BACQE: .WORD 0 ;NO QUEUE
BA: BR BA0
;***** BATSW1 MUST BE HERE
BATSW1: .WORD 0 ;BATCH HANDLER SWITCH 1
SOURCE= 4 ;IF 1 GET A CHARACTER THROUGH
;THE BATCH HANDLER. IF 0 LET
;THE EMT GO TO THE MONITER
BSOURC= 40000 ;IF 1 INPUT COMES FROM THE
;BATCH STREAM. IF 0 INPUT COMES
;FROM THE CTY:.
NOTTY= 400 ;DON'T ALLOW TELETYPE OUTPUT IN LOG
;******* NOTTY MUST BE 400 *******
DESTON= 2 ;IF 1 OUTPUT TO BATCH
;IF 0 OUTPUT TO RMON.
BDESTN= 100 ;IF 1 BATCH LOG IS OUTPUT
;IF 0 CTY: IS OUTPUT.
DATA= 40 ;IF 1 CHARACTERS FOLLOWING ARE
;USER DATA. IF 0 KMON.
ACTIVE= 20 ;CTY IS ACTIVE.
COMWAT= 10 ;A COMMAND IS WAITING
BEXIT= 100000 ;AN EXIT WAS SEEN WHILE DATA MODE SET
BGET= 200 ;"\G" MODE
HELP= 1 ;HELP MODE
;******* HELP MUST BE 1 *******
BA0: MOV BACQE,R0
BRINIT: BR INIT
INIT: BR INIT1 ;*** CHANGES TO POINTER TO BATSW1 AFTER INIT
INIT2: ADDR CHAIN,R1 ;RETURN ARGUMENT POINTERS TO BATCH
MOV 4(R0),R2 ;BUFFER TO PASS ARGS
1$: MOV (R1)+,(R2)+
BPL 1$
BATDON: ADDR BACQE,R4 ;SET UP RETURN
MOV @#SYSPTR,R5
JMP @QCOMPL(R5) ;AND EXIT
QCOMPL=270
.IF NE BATSTK
.BLKW BATSTK ;STACK SPACE
SPSAVE: .WORD 0 ;OLD STACK POINTER
.ENDC
INPBUF: ;INPUT BUFFER
INIT1: MOV R0,-(SP) ;INITIALIZE **** ONCE ONLY CODE ****
ADDR BATSW1,R0
MOV R0,INIT ;POINTER TO BATSW1 IN A CONVIENENT PLACE
INC BRINIT ;SO WE DON'T GET CALLED AGAIN
ADDR INPBUF,R0
MOV R0,INBUFF ;POINTER TO INPUT BUFFER
ADD #OUTBUF-INPBUF,R0
MOV R0,OBUFF ;POINTER TO OUTPUT BUFFER
MOV @#SYSPTR,R0
MOV EMT16(R0),R1 ;POINT TO POINTER TO EMT 16 TABLE
ADD R0,R1 ;POINTER TO EMT 16 TABLE IN R1
LINK1 0,O$TIN ;LINK HANDLER TO MONITOR (.TTYIN)
LINK1 1,O$TOT ;(.TTYOUT)
LINK1 10,O$EXT ;(.EXIT)
LINK1 11,O$PRN ;(.PRINT)
ADDR FB$EXT,R3 ;SET UP FOR SJ MONITOR
MOV R3,JSTATE ;ADDR WOULD CAUSE Z ERROR
BIT #FBMON$,CONFIG(R0) ;WHAT TYPE OF MONITOR IS IT
BNE FGBGMN ;ITS FGBG
LINK2 0,B$TIN ;NOW LINK RMON TO BATHND (.TTYIN)
LINK2 1,B$TOT ;(.TTYOUT)
LINK2 10,B$EXT ;(.EXIT)
LINK2 11,B$PRN ;(.PRINT)
MOV (SP)+,R0
JMP INIT2
FGBGMN: MOV @#SYSPTR,R0
MOV CONTXT(R0),JSTATE ;SET UP STATE TO POINT TO WORD
;WITH ADDRESS CHECKING BITS
LINK2 0,FB$TIN ;FGBG MON
LINK2 1,FB$TOT
LINK2 10,FB$EXT
LINK2 11,FB$PRN
MOV (SP)+,R0
JMP INIT2
OUTBUF= INBSIZ*2+INPBUF
.=INPBUF+INBSIZ+INBSIZ+OUBSIZ+OUBSIZ
.SBTTL BTTI
BTTI: JSR PC,GETCHR ;GET A CHARACTER
BTTIS: CMP #'\,R0 ;IS IT A BACKSLASH?
BEQ 2$ ;YES, BACKSLASHES GET SPECIAL TREATMENT
1$: TST (R4) ;CHECK FOR "EXIT" MODE
BMI 3$
RTS PC
3$: TST (SP)+
JMP BAT03B
2$: JSR PC,GETCHR ;CHECK THE CHAR AFTER THE "\"
CMP #'\,R0
BEQ 1$ ;FOR TWO BACKSLASHS YOU GET ONE.
INC R0
;***** KEEP BIC AND ASL TOGETHER ****
BIC (PC),R0
ASL R0 ;*2+2
;**********
TST (SP)+ ;WIPE OUT THE JSR
CMP #TABSIZ,R0 ;IS IT IN RANGE?
BLT ABORT ;NO, SOMETHING IS WRONG VERY WRONG
ADD PC,R0 ;POINT INTO TABLE
ADD (R0),PC ;DO JUMP TO ADDRESS OF FUNCTION
BATTBL: .WORD BAT00-BATTBL ;"\@"
.WORD BAT01-BATTBL ;"\A"
.WORD BAT02-BATTBL ;"\B"
.WORD BAT03-BATTBL ;"\C"
.WORD BAT04-BATTBL ;"\D"
.WORD BAT05-BATTBL ;"\E"
.WORD BAT06-BATTBL ;"\F"
.WORD BAT07-BATTBL ;"\G"
.WORD BAT08-BATTBL ;"\H"
.WORD BAT09-BATTBL ;"\I"
.WORD BAT10-BATTBL ;"\J"
.WORD BAT11-BATTBL ;"\K"
.WORD BAT12-BATTBL ;"\L"
TABSIZ=.-BATTBL
.SBTTL I,J,K, AND L DIRECTIVES
; GETREG POINTS R2 TO THE BATCH INTERNAL VARIABLE
; WHICH IS BEING REFERENCED BY A \K OR \I DIRECTIVE. THE 26 BATCH
; VARIABLES ARE RESIDENT IN THE HANDLER AT BATREG AND ARE REFERENCED
; BY THE LETTERS A - Z. NOTE THAT A PSEUDO-VARIABLE IS AVAILABLE
; THAT IS LOCATED AT THE FIXED OFFSET MONCOM INTO THE RT-11 RESIDENT.
; THIS VARIABLE CAN BE REFERENCED BY USING AN @ AS THE VARIABLE
; NAME. THE @ VARIABLE WILL BE SET BY FUTURE VERSIONS OF THE RT-11 CUSPS
; TO INDICATE WHETHER AN ERROR OCCURRED DURING EXECUTION. THIS WILL
; PERMIT PARTS OF A BATCH STREAM TO BE BY-PASSED IF ERRORS OCCURRED.
GETREG: JSR PC,GETBAT ;REGISTER NUMBER
MOV @#SYSPTR,R2 ;INITIALIZE TO MONCOM
ADD #MONCOM,R2
BIC #177740,R0 ;SELF PRESERVATION
BEQ JGTBAT ;SAVE CODE AND FETCH NEXT CHAR
1$: ADDR BATREG-1,R2
ADD R0,R2 ;R2 POINTES TO BYTE REGISTER
2$: BR JGTBAT ;SAVE SOME CODE AND FETCH THE NEXT CHAR
; \I PROCESSING -- IF STATEMENT
BAT09: JSR PC,GETREG ;GET REGISTER AND VALUE
CMPB (R2),R0 ;COMPARE REG WITH VALUE
BLT BAT10 ;REG= 2000,
BLO ADR0 ; ADD 2000
ADD #2000,R1
ADR0: TSTB OVFLG ;IS THIS AN OVERLAY FILE?
BEQ ADR2 ;NO, BYPASS
MOV SEG,R3 ;YES, CHECK SEGMENT SPECIFIED
BNE ADR1 ;YES, GO LOOK IT UP
TSTB INIFLG ;CHECK INIT PASS
BEQ ADR2 ;YES, BYPASS CHECKS
TST NOSEG ;MAKE SURE THERE ARE SEGMENTS
BEQ ADRE2
CMP R1,@OVTAB ;CHECK ADDRESS IN ROOT SEGMENT
BHIS ADRE3
BR ADR2
ADR1: CMP R3,NOSEG ;CHECK VALID SEGMENT NO.
BHI ADRE4
DEC R3
ASL R3
MOV R3,-(SP)
ASL R3
ADD (SP)+,R3
ADD OVTAB,R3 ;ADDRESS TABLE ENTRY
SUB (R3)+,R1 ;COMPUTE REL ADDRESS IN SEGMENT
MOV (R3)+,(SP) ;GET START BLOCK NO.
CMP R1,(R3) ;CHECK ADDRESS WITHIN SEGMENT
BHI ADRE5
ADR2: MOV R1,R2
BIC #177000,R2 ;R2 IS OFFSET WITHIN BLOCK
MOV R1,-(SP) ;DIVIDE FILE ADDRESS BY 1000
CLC
ROR (SP)
CLRB (SP)
SWAB (SP)
ADD (SP)+,(SP) ;COMPUTE ACTUAL BLOCK NO.
MOV (SP)+,R3
CMP R3,BLKNO ;IS IT THE SAME ALREADY READ IN
BEQ ADR4 ;YES, BYPASS READ
MOV R3,BLKNO
.READW 3,#BLOCK,#256.,BLKNO
BCS ADRE6
ADR4: ADD #BLOCK,R2 ;ADDRESS BUFFER LOC
MOV (SP)+,R1 ;RESTORE R1
MOV (SP)+,R3 ;AND R3
RTS PC
ADRE1: JSR R1,ERROR
.WORD ADRM1
NLJMP: JMP PROMPT
ADRE2: JSR R1,ERROR
.WORD ADRM2
BR NLJMP
ADRE3: JSR R1,ERROR
.WORD ADRM3
BR NLJMP
ADRE4: JSR R1,ERROR
.WORD ADRM4
BR NLJMP
ADRE5: JSR R1,ERROR
.WORD ADRM5
BR NLJMP
ADRE6: JSR R1,ERROR
.WORD ADRM6
JMP ASKFIL
;--------------------------------------------------------------
; SUBROUTINE 'CLOSE' CALLED BY JSR PC
; CLOSES THE OPEN LOCATION OR BYTE,
; WRITING OUT THE MODIFIED BLOCK
; ON THE FILE.
CLOSE: TST OPNADR ;CHECK ADDRESS OPEN
BEQ CLOS2 ;NO, EXIT
TSTB TYPFLG ;WAS ANYTHING TYPED?
BEQ CLOS2
MOV RCON,R2
ADD RC(R2),R1 ;RELOCATE VALUE STORED
TSTB BYTFLG ;IS THE OPEN LOCATION A BYTE
BNE CLOS3
MOV R1,@OPNADR ;STORE VALUE IN BUFFER
CLOS1: .WRITW 3,#BLOCK,#256.,BLKNO
BCS CLOSE1
CLOS2: CLR OPNADR
RTS PC
CLOS3: MOVB R1,@OPNADR ;SET BYTE VALUE IN BUFFER
BR CLOS1
CLOSE1: JSR R1,ERROR
.WORD CLOSM1
JMP ASKFIL
;-----------------------------------------------------------------
; SUBROUTINE 'CONT' CALLED BY JSR PC
; TYPES THE CONTENTS OF THE OPEN LOCATION
CONT: JSR R1,PRINT
.WORD SPC
TSTB BYTFLG
BNE CON2
MOV @OPNADR,R0
JSR PC,TYPWRD
CON1: JSR R1,PRINT
.WORD SPC
RTS PC
CON2: MOVB @OPNADR,R0
JSR PC,TYPBYT
BR CON1
;----------------------------------------------------------------
; SUBROUTINE 'ERROR' CALLED BY JSR R1,ERROR
; .WORD MESSAGE
; PRINTS THE MESSAGE SPECIFIED IN THE
; CALLING SEQUENCE, IN RT-11 ERROR FORMAT.
ERROR: JSR R1,PRINT
.WORD CLQ
MOV (R1)+,ERR1
JSR R1,PRINT
ERR1: .WORD ASKM2
JSR R1,PRINT
.WORD QCL
RTS R1
;--------------------------------------------------------------
; SUBROUTINE 'INITOV' CALLED BY JSR PC
; INITIALIZES THE OVERLAY TABLE
; IF INIFLG CLEAR, SETS INIFLG
; RESTORES ALL REGISTERS
INITOV: TSTB INIFLG ;CHECK ALREADY INIT
BEQ INI1
INI0: RTS PC ;YES, DONE
INI1: JSR R5,SAVREG
MOV #-1,HIGH ;(INIT HIGH LOCATION)
CLR SEG
TSTB MONFLG ;CHECK MONITOR FILE
BNE INI1A ;YES, BYPASS
MOV #50,R1 ;READ HIGH LIMIT OF PROGRAM
JSR PC,ADRLOC
MOV (R2),HIGH
INI1A: TSTB OVFLG ;CHECK OVERLAY FILE
BEQ INI0 ;NO, DONE
CLR NOSEG ;FORGET OVERLAYS
TST BOTTM ;CHECK BOTTOM ADDRESS SPECIFIED
BNE INI2 ;YES, USE IT
MOV #42,R1 ;NO, READ INIT STACK POINTER
JSR PC,ADRLOC
MOV (R2),BOTTM ;SAVE BOTTOM ADDRESS
INI2: BIT #1,BOTTM ;CHECK BOTTOM ADDRESS IS EVEN
BNE INIE1
MOV #20.,R4 ;# WORDS CHECKED IN OVERLAY HANDLER
MOV #$OVRH,R3 ;ADDRESS MODEL
MOV BOTTM,R1
MOV #$OVTAB,R0 ;RELOCATE MODEL OVERLAY HANDLER
SUB R3,R0
ADD R1,R0
SUB #6,R0
MOV R0,$OVRHA+2
INI3: JSR PC,ADRLOC ; *** MAKES SURE THE OVERLAY
CMP (R2),(R3)+ ; HANDLER IS STORED AT THE
BNE INIE2 ; BOTTOM ADDRESS ***
TST (R1)+
DEC R4
BNE INI3
INI4: MOV OVTAB,R3 ;INIT TO SAVE OVERLAY TABLE
MOV BOTTM,R1
ADD #104,R1
INI5: JSR PC,ADRLOC ;ADDRESS NEXT SEGMENT TABLE ENTRY
BIT #1,(R2) ;IS IT ODD ?
BNE INI6 ;YES, DONE
CMP R3,OVTABE ;ENOUGH ROOM TO STORE IT?
BHIS INIE3
MOV (R2),(R3)+ ;SAVE FIRST WORD
ADD #2,R1
JSR PC,ADRLOC ;ADDRESS NEXT
MOV (R2),(R3)+ ;SAVE 2ND WORD
ADD #2,R1
JSR PC,ADRLOC ;ADDRESS NEXT
MOV (R2),(R3) ;SAVE 3RD WORD
CLC ;COMPUTE BYTES FROM WORDS
ROL (R3)
DEC (R3)+
ADD #2,R1 ;MOVE TO NEXT ENTRY
INC NOSEG ;COUNT SEGMENTS
BR INI5 ;LOOP FOR ALL SEGMENTS
INI6: INCB INIFLG ;SET 'INITIALIZED' FLAG
RTS PC ;RESTORE REGS AND RETURN
INIE1: JSR R1,ERROR
.WORD INIM1
NLJMP2: JMP PROMPT
INIE2: JSR R1,ERROR
.WORD INIM2
BR NLJMP2
INIE3: JSR R1,ERROR
.WORD INIM3
JMP ASKFIL
;-------------------------------------------------------
; SUBROUTINE 'PRINT' CALLED BY JSR PC,PRINT
; .WORD ADDR
; PRINTS THE ASCII MESSAGE AT ADDR
PRINT: MOV R2,-(SP)
MOV (R1)+,R2
PRINT1: MOVB (R2)+,R0
BEQ PRINT2
.TTYOUT
BR PRINT1
PRINT2: MOV (SP)+,R2
RTS R1
;------------------------------------------------------
; SUBROUTINE 'SAVREG' CALLED BY JSR R5,SAVREG
; SAVES ALL REGISTERS ON THE STACK,
; AND RESTORES THEM WHEN THE NEXT
; 'RTS PC' INSTRUCTION IS EXECUTED.
SAVREG: MOV R4,-(SP)
MOV R3,-(SP)
MOV R2,-(SP)
MOV R1,-(SP)
MOV R0,-(SP)
MOV R5,-(SP)
MOV 12(SP),R5
JSR PC,@(SP)+
RESREG: MOV (SP)+,R0
MOV (SP)+,R1
MOV (SP)+,R2
MOV (SP)+,R3
MOV (SP)+,R4
MOV (SP)+,R5
RTS PC
;-------------------------------------------------------
; SUBROUTINES 'TYPBYT' AND 'TYPWRD'
; CALLED BY JSR PC
; R0 CONTAINS VALUE
; TYPE OUT THE CONTENTS OF THE
; BYTE, WORD, RESPECTIVELY, IN R0.
; RESTORES ALL REGISTERS
TYPBYT: JSR R5,SAVREG
BIC #177400,R0 ;CLEAR UPPER BYTE
MOV #3,R1 ;PREPARE TO PRINT 3 DIGITS
BR TYP1
TYPWRD: JSR R5,SAVREG
MOV #6,R1 ;PRINT 6 DIGITS
TYP1: MOV R1,R2 ;SAVE COPY OF COUNT
TYP2: MOV R0,-(SP)
BIC #177770,(SP) ;PUT NEXT DIGIT ON STACK
CLC ;POSITION NEXT
ROR R0
ASR R0
ASR R0
DEC R1 ;DO FOR ALL DIGITS
BNE TYP2
TYP3: MOV (SP)+,R0 ;GET NEXT DIGIT
DEC R2 ;CHECK LAST ONE
BEQ TYP4 ;YES, PRINT IT
TST R1 ;CHECK ANY TYPED YET
BNE TYP4 ;YES, MUST TYPE THIS ONE
TST R0 ;NO, CHECK LEADING 0
BEQ TYP5 ;YES, BYPASS
TYP4: ADD #'0,R0 ;COMPUTE ASCII DIGIT
.TTYOUT ;TYPE IT
INC R1 ;COUNT DIGITS
TYP5: TST R2 ;CHECK DONE
BNE TYP3
RTS PC
; MODEL OVERLAY HANDLER
$OVRH: MOV R0,-(SP)
MOV R1,-(SP)
MOV R2,-(SP)
$OVRHB: BR $FIRST
MOV R0,R1
$OVRHA: ADD #$OVTAB-6,R1
MOV (R1)+,R2
CMP R0,@R2
BEQ $ENTER
.READW 17,R2,(R1)+,(R1)+
BCS $ERR
$ENTER: MOV (SP)+,R2
MOV (SP)+,R1
MOV (SP)+,R0
MOV @R5,R5
RTS R5
$FIRST: MOV #12500,$OVRHB
MOV (PC)+,R1
$HROOT: .WORD 0
MOV (PC)+,R2
$HOVLY: .WORD 0
1$: CLR (R1)+
CMP R1,R2
BLO 1$
BR $OVRHB
$ERR: EMT 376
.BYTE 0,373
$OVRHE:
$OVTAB:
; VARIABLES AND FLAGS
RVAL: .WORD 0 ;VALUE OF 1ST ARG
HIGH: .WORD 0 ;HIGH LIMIT OF PROGRAM
SEGMNT: .WORD 0 ;SEGMENT NO. SPECIFIED
BOTTM: .WORD 0 ;BOTTOM ADDRESS
RCON: .WORD 0 ;RELOCATION CONSTANT
OPNLOC: .WORD 0 ;ADDRESS OF OPEN WORD OR BYTE
SEG: .WORD 0 ;SEGMENT FOR ADDRESSING FILE
BLKNO: .WORD 0 ;BLOCK NO. CURRENTLY IN CORE
NOSEG: .WORD 0 ;NO. OF SEGMENTS ON FILE
OVTAB: .WORD 0 ;START OF OVERLAY TABLE
OVTABE: .WORD 0 ;HIGHES WORD AVAILABLE FOR OVERLAY TABLE
OPNADR: .WORD 0 ;ADDRESS OF OPEN LOC IN BUFFER
RC: .WORD 0,0,0,0,0
.WORD 0,0,0,0
DEFEXT: .RAD50 'SAV' ;DEFAULT FILE EXTENSION
; (BYTE VARIABLES)
INIFLG: .BYTE 0 ;SET IF OVERLAY FILE INITIALIZED
TYPFLG: .BYTE 0 ;SET IF ANYTHING HAS BEEN TYPED
BYTFLG: .BYTE 0 ;SET IF BYTE IS OPEN
OVFLG: .BYTE 0 ;SET IF AN OVERLAY FILE /O
MONFLG: .BYTE 0 ;SET IF A MONITOR FILE /M
; PRINT MESSAGES
MSGHDR: .BYTE CR,LF
.ASCIZ 'PATCH V01-02 '
MSGFIL: .BYTE CR,LF,LF
.ASCII 'FILE NAME--'
.BYTE CR,LF,0
PTM1: .ASCIZ 'NO ADDR OPEN'
PTM2: .ASCIZ 'MUST OPEN WORD'
PTM3: .ASCIZ 'ODD ADDRESS'
PTM4: .ASCIZ 'INVALID RELOC REG'
ASKM1: .ASCIZ 'INCORRECT FILE SPEC'
ASKM2: .ASCIZ 'BAD SWITCH'
ADRM1: .ASCIZ 'NOT IN PROGR BOUNDS'
ADRM2: .ASCIZ 'PROGR HAS NO SEGS'
ADRM3: .ASCIZ 'MUST SPECIFY SEG'
ADRM4: .ASCIZ 'INVALID SEG NO'
ADRM5: .ASCIZ 'ADDR NOT IN SEG'
ADRM6: .ASCIZ 'READ ERROR'
CLOSM1: .ASCIZ 'WRITE ERROR'
INIM1: .ASCIZ 'ODD BOTTOM ADDR'
INIM2: .ASCIZ 'BOTTOM ADDR WRONG'
INIM3: .ASCIZ 'INSUFFICIENT CORE'
CLQ: .BYTE CR,LF
.ASCIZ '?'
QCL: .ASCII '?'
CRLF: .BYTE CR,LF,0
MCU: .ASCII '^U'
.BYTE CR,LF,0
SLS: .ASCII '/\'
SPC: .BYTE 11,0
; TABLE OF COMMANDS
COMTAB: .ASCII ' ;/\@^BRFE,:'
.BYTE LF,CR
NOCOM= 16 ;NO OF COMMANDS IN TABLE
.EVEN
BRTAB: .WORD NEWCHA
.WORD SEMI
.WORD SLASH
.WORD BSLASH
.WORD ATSIGN
.WORD UPARRO
.WORD BSET
.WORD RSET
.WORD ASKFIL
.WORD EXIT
.WORD RELOC
.WORD COLON
.WORD LFEED
.WORD CARRET
; FILE I/O BUFFER (1 BLOCK)
BLOCK:
.=.+512. ;256 WORDS
DEVSPC: ;START OF DEVICE SPACE AND FREE CORE
.END START
.IF DF MBUILD
.TITLE MBUILD OVERLAY V02-03
.IFF
.TITLE PIP OVERLAY V04-06
.ENDC
; RT-11 PIP (PERIPHERAL INTERCHANGE PROGRAM)
; AND
; RT-11 MBUILD (MAGTAPE BUILD PROGRAM
;
; DEC-11-ORPPA-E
;
; COPYRIGHT (C) 1973,1974,1975
;
; DIGITAL EQUIPMENT CORPORATION
; MAYNARD, MASSACHUSETTS 01754
;
; THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY
; ON A SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH
; THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE,
; OR ANY OTHER COPIES THEREOF, MAY NOT BE PROVIDED OR OTHERWISE MADE
; AVAILABLE TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO
; ONE WHO AGREES TO THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE
; SOFTWARE SHALL AT ALL TIMES REMAIN IN DIGITAL.
;
; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO
; CHANGE WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED
; AS A COMMITMENT BY DIGITAL EQUIPMENT CORPORATION.
;
; DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE
; OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT
; WHICH IS NOT SUPPLIED BY DIGITAL.
;
; MAY 2, 1973
;
; HANK MAURER
; LOUISE GERHART
; ANTON CHERNOFF
; JUNE 25, 1974
;
; BOB FRIEDENTHAL
;
; NOVEMBER 1974,JANUARY 1975,AUGUST 1975
;
; BOB BEAN
;
;
.SBTTL MACRO DEFINITIONS
.MCALL ..V1..
.MCALL .CLOSE, .CSISPC,.DELETE,.DSTATU,.FETCH, .HRESET
.MCALL .LOOKUP,.PRINT, .RCTRLO,.RENAME,.REOPEN,.SAVEST
.MCALL .SETTOP,.SRESET,.TTYIN, .TTYOUT,.UNLOCK,.LOCK
.MCALL .READW, .WAIT, .DATE, .WRITW, .EXIT, .REGDEF
.MCALL .CSIGEN,.SERR ,.TRPSET,...CM1,...CM2,...CM3
..V1.. ;USE V1 MACRO FORMAT
.REGDEF ;DEFINE REGISTERS
.MACRO MESSAGE TEXT
JSR R3,PUTMSG
.ASCIZ TEXT
.EVEN
.ENDM MESSAGE
.MACRO ERROR TEXT
JSR R0,MSG
.ASCIZ "?TEXT?"
.EVEN
.ENDM ERROR
.MACRO SWITCH CHAR,ADR,MODE,VALUE
.BYTE ''CHAR,MODE
.IF B VALUE
.WORD 0
.IFF
VALUE: .WORD 0
.ENDC
.IF EQ MODE
.WORD ADR-COPY
.IFF
ADR: .WORD 0
.ENDC
.ENDM SWITCH
;THE FOLLOWING MONITOR FEATURES ARE USED IN NON-STANDARD CALLS
; HENCE, THE USUAL MACROS ARE NOT USED
.MACRO .ENTER CH
EMT 40+CH
.ENDM .ENTER
.MACRO .READ CH
EMT 200+CH
.ENDM .READ
.MACRO .WRITE CH
EMT 220+CH
.ENDM .WRITE
;SYMBOL DEFINITIONS
NLIMIT = 37 ;MAX # OF DIRECTORY SEGMENTS ALLOWED
STRTAD = 40 ;USER PROGRAM START ADDRESS
JSW = 44 ;JOB STATUS WORD
EMTERR = 52 ;RT-11 ERROR RETURN WORD
SYSPTR = 54 ;POINTER TO RT-11 RESIDENT
DIRBLK = 6 ;STARTING BLOCK OF DIRECTORIES
OFFSET = 256 ;OFFSET TO VITAL RMON WORDS
;OFFSET IS DIFF OF BLKEY AND $RMON
SYSUNT = 275 ;OFFSET TO SYSTEM DEVICE UNIT #
CONFIG = 300 ;OFFSET TO CONFIG WORD
R50STAR = 132500 ;* IN RADIZ 50 (FROM CSI)
DIREOB = 4000 ;DIRECTORY BIT SAYING END OF BLOCK
DIRPRM = 2000 ;BIT SAYING PERMANENT FILE
DIREMP = 1000 ;BIT SAYING EMPTY ENTRY
DIRESZ = 16 ;SIZE OF 1 ENTRY (+ XTRABY)
FGACTV = 200 ;BIT IN CONFIG SAYING FG ACTIVE
CSWEOF = 20000 ;EOF BIT IN CSW
HDR1 = 42110 ;ASCII H,D
EOF1 = 47505 ;ASCII E,O
RXCS = 177170 ;ADDRESS OF RX11 CONTROL/STATUS REGISTER
.IF NDF MBUSSC
RSCS2 = 172050 ;ADDRESS OF RH11/RJS03/4 CONT REG 2
.ENDC
.IF DF MBUSSC
RSCS2 = 176310 ;ADDRESS OF RH11/RJS03/4 CR2
.ENDC
;DEVICE IDENTIFICATION CODES IN $STAT
RKIDEN=0 ;RK11/RK05,RK03
DTIDEN=1 ;TC11/TU56
TMIDEN=11 ;TM11/TU10/TSO3
RFIDEN=12 ;RF11/RS11
CTIDEN=13 ;TA11/TU60
RJIDEN=16 ;RJS03/4
TJIDEN=20 ;TJU16
DPIDEN=21 ;RP11/RP02,RP03
DXIDEN=22 ;RX11/RX01
;ASCII CHARACTERS
RUBOUT=377 ;RUBOUT
ASTRSK=52 ;ASTERISK
.GLOBL ILLCMD,FGCHK,DEVINF,SSB,HANERR,REBOT,FILDES
.SBTTL REBOOT
;
; THIS CODE REBOOTS THE SYSTEM FROM ANY OF THE DEVICES
; SPECIFIED IN THE TABLE AT BOOTDV. THE COMMAND IS ANALYZED,THE
; DEVICE IS LOOKED UP IN THE TABLE,AND IF FOUND,THE CORRESPONDING
; ROUTINE IN THE TABLE AT BOOTAD IS ENTERED TO PEFORM THE BOOT
;
;BOOTDV-TABLE OF DEVICE CODES WHICH LISTS DEVICES FROM WHICH RT-11
;CAN BE BOOTED. THIS TABLE IS ORDERED TO CORRESPOND WITH THE
;TABLE BOOTAD,WHICH CONTAINS THE ADDRESSES OF THE CORRESPONDING
;BOOTSTRAP ROUTINE FOR EACH DEVICE.
BOOTDV: .IF NDF MBUILD
.BYTE DTIDEN ;TC11/TU56 DECTAPE
.BYTE DXIDEN ;RX11/RX01 FLOPPY DISK
.ENDC
.BYTE RFIDEN ;RF11/RS11 FIXED HEAD DISK
.BYTE DPIDEN ;RP11/RP02,RP03 DISK CARTRIDGE
.BYTE RKIDEN ;RK11/RK05,RK03 DECPACK DISK
.BYTE RJIDEN ;RH11/RJSO3/4 FIXED HEAD DISK
BDVEND: .EVEN ;END OF TABLE
;BOOTAD-TABLE OF ADDRESSES FOR BOOTSRAP ROUTINES FOR EACH OF THE
;DEVICES SPECIFIED IN BOOTDV. INDEX OF DEVICE IN BOOTDV IS
;USED AS INDEX INTO THIS JUMP TABLE.
BOOTAD: .IF NDF MBUILD
DTBOOT ;TC11
DXBOOT ;RX11
.ENDC
RFBOOT ;RF11
DPBOOT ;RP11
RKBOOT ;RK11
RJBOOT ;RJSO3/4
;REBOOT ROUTINE
;ANALYZES /O COMMAND TO DETERMINE WHICH DEVICE WAS SPECIFED BY
;LOOKING FOR THE CODE OF THE SPECIFIED DEVICE IN BOOTDV. IF THE
;CODE IS FOUND,THE APPROPRIATE ROUTINE IS ENTERED
REBOT: JSR PC,FGCHK ;MAKE SURE FG IS NOT PRESENT
MOV #FILDES+36,R5 ;POINT TO INPUT LIST
TST (R5) ;WAS A DEVICE SPECIFIED?
BEQ 4$ ;NO
TST (R4) ;ANY OUTPUT FILES SPECIFIED?
BEQ 3$ ;NO
4$: JMP ILLCMD ;BAD COMMAND
3$: TST 2(R5) ;ANY INPUT FILES?
BNE 4$ ;YES-/O PROBABLY MISTAKE
.DSTATU #DEVINF,R5 ;GET CODE FOR THE DEVICE
.LOOKUP 1,R5 ;NON-FILE STRUCTURED LOOKUP ON DEVICE,FOLLOWED
.SAVEST 1,#SSB ;BY A SAVESTATUS WILL MAKE UNIT # AVAILABLE
MOV #BOOTDV,R0 ;POINT TO LEGAL DEVICE CODE TABLE
1$: CMPB DEVINF,(R0)+ ;LOOK FOR DECIE
BEQ DVFND ;FOUND THE DEVICE
CMP R0,#BDVEND ;END OF TABLE?
BLO 1$ ;NO-EXAMINE NEXT ENTRY
HANER1: JMP HANERR ;YES-DEVICE SPECIFIED MUST BE ILLEGAL
DVFND: SUB #BOOTDV+1,R0 ;GET INDEX OF DEV IN BOOTDV
ASL R0 ;ADDRESSES ARE EVEN
JMP @BOOTAD(R0) ;ENTER BOOT ROUTINE FOR DEVICE
;BM793-COMMON BOOTSTRAP ROUTINE FOR RP11,RK11,TC11,RF11
;ON ENTRY,R0 POINTS TO CONTROLLER WORD COUNT REGISTER
;R1 CONTAINS CONTROLLER COMMAND VALUE TO CAUSE A READ
;R2 CONTAINS APPROPRAITE UNIT VALUE TO PUT IN CONTROLLER
;R3 CONTAINS ADDRESS OF CONTOLLER REGISTER TO RECIEVE R2
BM793: .HRESET ;NOW BEGINS THE BOOT
2$: RESET
MOV R2,@R3 ;PUT UNIT # IN REGISTER POINTED TO BY R3
MOV R0,R5 ;WE CAN'T DESTROY R0
MOV #-256.,@R5 ;SET WORD COUNT
CMP R5,#177344 ;IS THIS DECTAPE?
BNE 3$ ;NO
MOV #4002,-(R5) ;YES-MUST SEARCH FOR BLOCK 0
TST @R5
BPL .-2
TST -(R5)
BPL 2$
CMP (R5)+,(R5)+ ;AT BLOCK 0-POINT R5 TO COMMAND REGISTER
3$: MOV R1,-(R5) ;STUFF COMMAND REGISTER WITH READ COMMAND
TSTB @R5 ;WAIT TO FINISH
BPL .-2
TST @R5 ;ERROR?
BMI 2$ ;YES-TRY AGAIN
CLRB @R5 ;NO-STOP DEVICE
JMP @#0 ;AND START SECONDARY BOOT CODE
.IF NDF MBUILD
;FLOPPY BOOT ROUTINE
PS: RTI ;USED TO LOAD PS FROM STACK IN MACHINE
;INDEPENDENT FASHION
DXBOOT: .HRESET ;STOP ALL RT-11 I/O
RESET ;STOP TERMINAL AND CLOCK
DECB SSB+11 ;UNIT #-1 IN SAVED STATUS BLOCK
BMI UNIT0 ;IF RESULT<0,UNIT WAS 0
BNE HANER1 ;ANY UNIT BUT 0 OR 1 ILLEGAL
MOV #20,R2 ;BOOT FROM UNIT 1
BR UNIT1
UNIT0: CLR R2
UNIT1: BIS #100247,R2 ;R2=20 FOR UNIT 1 BOOT
MOV #340,-(SP) ;PUT DESIRED PRIORITY ON STACK
;THS FOLLOWING INSTRUCTION IS MACHINE
;INDEPENDENT WAY TO LOAD PS
JSR PC,PS ;LOAD PS FROM STACK WITH RTI INST
1$: MOV #RXCS,R1 ;POINT R1 TO STATUS REGISTER FOR CONTROLLER
2$: BITB R2,@R1 ;WAIT FOR FLOPPY DONE
BEQ 2$
MOVB #7,R3 ;SET SECTOR/TRACK/LOOP CONTROL
MOV R1,R0 ;SET UP TO POINT TO RXDB
MOV R2,(R0)+ ;LOAD READ AND GO FUNCTION
BR 4$ ;GO TO WAIT LOOP
3$: MOV #1,@R0 ;1ST SECTOR 1, 2ND TRACK 1, 3RD JUNK
4$: ASR R3 ;STEP THROUGH SECTOR/TRACK SEQ
BCS 6$ ;BRANCH TO WAIT,SIT CYCLE NOT DONE
MOVB (PC)+,@R1 ;LOAD EMPTY BUFFER COMMAND
5$: MOVB @R0,(R3)+ ;MOVE DATA BYTE TO MEMORY
6$: BIT R2,@R1 ;WAIT FOR TR DONE OR ERROR
BEQ 6$
BMI 1$ ;BRANCH TO RETRY IF ERROR
BCS 3$ ;BRANCH IF IN SECTOR/TRACK LOOP
TSTB @R1 ;IS DATA TRANSFER DONE
BMI 5$ ;BRANCH TO TRANSFER MORE
CLR R0 ;MAKE SURE LOC 0 IS 240
CMP #240,@R0
BNE 1$ ;BRANCH IF NOT TO RETRY
CMPB #247,R2 ;SET C=1 IF UNIT 1 BOOT
ADC R0 ;R0=0 IF UNIT0,1 IF UNIT 1
CLR PC ;GO TO SECONDARY BOOT
;TC11 BOOT ROUTINE
DTBOOT: MOV #177344,R0 ;ADDR OF WC REGISTER IN R0
.ENDC
ONEONL: TSTB SSB+11 ;ONLY UNIT 0 ALLOWED
BNE HANER1 ;ILLEGAL DEVICE IF UNIT NOT 0
CLR R3 ;DON'T NEED UNIT POINTER
READ5G: MOV #5,R1 ;READ COMMAND IS READ (4)+GO (1)
BR BM793 ;DO COMMON BOOT
;RK11 BOOT ROUTINE
RKBOOT: MOVB SSB+11,R2 ;UNIT INTO R2
CLC
ROR R2 ;SLIDE UNIT TO BITS 15-13
ROR R2
ROR R2
ROR R2
MOV #177412,R3 ;R3 POINTS TO UNIT REGISTER
MOV #177406,R0 ;R0 POINTS TO WC
BR READ5G ;SET READ COMMAND AND GO TO BOOT
;RF11 ROUTINE
RFBOOT: MOV #177462,R0 ;POINT R0 TO WC
BR ONEONL ;THE RESET IS SHARED WITH DECTAPE
;RP11 ROUTINE
DPBOOT: MOV #176716,R0 ;POINT RO TO WC
MOV SSB+10,R1 ;UNIT # INTO R1
BIC #174377,R1 ;STRIP TO UNIT BITS
ADD #5,R1 ;READ COMMAND IN R1
CLR R3 ;DON'T NEED SEPERATE UNIT
BR BM793
;RJS03/4 ROUTINE
RJBOOT: .HRESET ;STOP ALL RT-11 I/O,INCLUDING TTY
RESET ;AND STOP ALL PDP-11 I/O
MOV #RSCS2,R5 ;POINT R5 TO RH11 CONROL REG 2
MOVB SSB+11,(R5) ;SET UNIT
CLR -(R5) ;READ BLOCK 0
CLR -(R5) ;INTO ADRRESS 0
MOV #177400,-(R5) ;READ ONE BLOCK
MOV #71,-(R5) ;GO
1$: BIT #100200,(R5) ;TEST FOR DONE OR ERROR
BEQ 1$ ;WAIT
BMI RJBOOT ;KEEP TRYING ON ERROR
CLR PC ;BOOT DONE-START SECONDARY
.END ;END OF BOOTSRAP OVERLAY