Trailing-Edge
-
PDP-10 Archives
-
bb-d868c-bm_tops20_v4_2020_distr
-
language-sources/loio.mac
There are 18 other files named loio.mac in the archive. Click here to see a list.
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1972,1973,1974,1977,1978 DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. 01754
; CONDITIONAL ASSEMBLY PAGE
; =========================
; CMUSW = 1 FOR A CMU VERSION OF BLISS
; 0 FOR A STANDARD VERSION.
; (THE CMU VERSION RECOGNIZED THE CMU PPN'S)
;
;
; BLIS11 = 1 FOR BLISS 11 COMPILER I/O MODULE (BL11IO)
; 0 FOR BLISS 10 COMPILER I/O MODULE (BLISIO)
;
;
; TIMSW = 1 TO GENERATE TIMING HOOKS
;
;
; NONREN = 1 TO GENERATE NONSHARABLE CODE
; 0 FOR SHARABLE CODE
;
;
; DETSW = 1 TO CHECK FOR DETACHED JOB AT TTYOUT
; 0 FOR NO CHECK (UN-NECESSARY ON STANDARD DEC SYSTEMS)
;
;
; REQLVL = <ALLOWED DEPTH OF REQUIRE>
; REVISION HISTORY
;
; 2/16/78 CODE ADDED TO TYPE OUT CORRECT SWITCH CHARACTERS IF
; THEY ARE GIVEN IN COMPLEMENT FORM.
; EX: /-V,/-B,/-K,/-P
;
; 1/18/78 ROUTINE RENAM IS MODIFIED TO FIX COMPATABILITY BUG
; ON DEC10 AND DEC20. ON DEC20, RENAME FILLS UP
; CREATION DATE/TIME AND GIVES WRONG DATE IF
; COMPILER FILLS UP. ON DEC10, RENAME
; ALWAYS FILLS UP CREATION DATE/TIME CORRECTLY.
;
; 1/11/77 ROUTINES SRCDEL AND SAVSRC ADDED.
; BLOCK SRCBLK ADDED.
; CALLS ON ABOVE ROUTINES ADDED.
; AREA DELBLK DROPPED.
;
; 1/26/77 CODE ADDED TO HANDLE DEL CHARACTERS IN INPUT STREAM.
; THEY ARE COUNTED AND DROPPED.
;
; END OF REVISION HISTORY
LOIOV==: 14 ; MODULE VERSION NUMBER
IFNDEF NONREN, <NONREN==0>
IFNDEF TIMSW, <TIMSW==0>
IFNDEF DETSW, <DETSW==0>
IFNDEF CMUSW, <CMUSW==0>
IFNDEF BLIS11, <BLIS11==0>
IFNDEF REQLVL, <REQLVL==6>
REQFST==<17-REQLVL>+1 ; FIRST REQUIRE CHANNEL
IFLE <REQFST-4>, <PRINTX ? TOO MANY REQUIRE CHANNELS
PASS2
END>
IFN NONREN, <RELOC>
IFE NONREN, <TWOSEG
RELOC 400000>
IFE BLIS11, <
TITLE BLISIO - BLISS COMPILER I/O W.WULF & J. NEWCOMER/FLD
IFE CMUSW, <
IF1 <PRINTX LOIO - STANDARD VERSION>
DEFINE SUBTLE (STR) <
SUBTTL BLISIO - STANDARD VERSION - STR
PAGE >>
IFN CMUSW, <
IF1 <PRINTX LOIO - CMU VERSION>
DEFINE SUBTLE (STR) <
SUBTTL BL10IO---CMU VERSION---STR
PAGE >>
>
IFN BLIS11, <
TITLE BL11IO BLISS COMPILER I/O W. WULF & J. NEWCOMER/FLD
IFE CMUSW, <
IF1 <PRINTX BL11IO MODULE - STANDARD VERSION>
DEFINE SUBTLE (STR) <
SUBTTL BL11IO---STANDARD VERSION---STR
PAGE >>
IFN CMUSW, <
IF1 <PRINTX BL11IO MODULE - CMU VERSION>
DEFINE SUBTLE (STR) <
SUBTTL BL11IO---CMU VERSION---STR
PAGE >>
>
IFN TIMSW, <IF1 <PRINTX TIMING TURNED ON>>
IFN DETSW, <IF1 <PRINTX DETACHED JOB CHECK ENABLED>>
SUBTLE <DECLARATIONS>
DEFINE BLK(A,B)
< A== ZZ
ZZ== ZZ+B>
ZZ== 0
BLK SEQNUM, 1 ;REGISTER FOR SEQUENCE NUMBER
BLK PAGCNT, 1 ;REGISTER FOR PAGE COUNT
BLK TTLBUFF, 21 ;BUFER FOR PROGRAM TITLE
BLK XDATE, 1 ;REGISTER FOR DATE OF COMPILATION
BLK XP, 45 ;EXECUTIVE PUSHDOWN LIST
BLK XA, 16 ;EXECUTIVE ACCUMULATOR STORAGE
BLK XE, 11 ;EXECUTIVE OPEN ARRAY
BLK XB, 22 ;EXECUTIVE BUFFER HEADERS
;EXTERNS AND ENTRIES
IFN BLIS11,<
EXTERN DOPAGE ;TRUE IF NEED TO PRINT FF BEFORE BUFF
EXTERN BUFFL> ;MAX. NO. OF CHARS PER INPUT LINE
EXTERN .JBFF,.JBREL,.JBVER ;JOB DATA AREA FIELDS
EXTERN BXA,BUFF,PBUFF,DEVBPT
EXTERN PACCUM
INTERN CCLCTL,CCLBUF,CCLBP ;CCL GLOBAL DATA
INTERN FORCE,TTYLIST,READTEXT,INITIO ;I/O ROUTINES CALLED
INTERN FINIO,PAGE ; BY THE COMPILER
INTERN BIO ;0 IF INITIO HAS NEVER BEEN CALLED
EXTERN PUNT ;COMPILER BAD ERROR RECOVERY ROUTINE
EXTERN REQCHN,REQDATA,REQREL
EXTERN NOENGLISH, STARTBLOCK
EXTERN XR1COM ;=1 IF COMPACT XREF LISTING WANTED: /Q
IFE BLIS11, <
EXTERN DEBFLG ; FLAG TO GENERATE DEBUG LINKAGE
EXTERN ERRORFOUND ; # OF ERRORS IN PROGRAM
EXTERN ZFLAG ; FLAG FOR SREG,FREG,VREG,DREGS,RESREGM TO OUTPUT INTO REL
INTERN PAGER ; CALLED BY COMPILER
INTERN RPAGE
EXTERN MHTIME ;MASTER TIMING SWITCH
EXTERN CODETOG >
IFN TIMSW,<
EXTERN TIMER >
$F=:2
$V=:3
;BITS FOR GETCHR STATUS AND IO STATUS CALLS
AMODE== 3 ; BITS FOR ASCII AND ASCII LINE
TTYBIT== 10 ; DEVICE IS A TTY
BMODE== 10000 ; BIT FOR BINARY MODE
IOEOF== 20000 ; END OF FILE ON IO DEVICE
IOBKTL== 40000 ; IO BLOCK TOO LARGE
IODATA== 100000 ; IO DATA ERROR
IODEV== 200000 ; IO DEVICE ERROR
;ACCUMULATOR ASSIGNMENTS
A== 2 ;ARGUMENTS
B== 1 ;SCRATCH AND FILENAME CHAR CNT
C== 13 ;SCRATCH
D== 14 ;DEVICE CHANNEL NUMBER
E== 0 ;BYTE POINTER AC FOR GETCHR
F== 12 ;FLAGS
G== 10 ;SCRATCH
H== 11 ;SCRATCH
P== 17 ;PUSHDOWN ACCUMULATOR
R== 3 ;USED IN NUMOUT AND CMDCHR ROUTINES
S== 4 ;SIXBIT SYMBOL
T== 16 ;DATA AREA POINTER
V== 15 ;DATA AREA POINTER, TEMPORARY
;ACCUMULATORS USED BY THE COMPILER IN CALLS TO THE EXEC
CH== 4 ;CHANNEL NUMBER FOR READTEXT
BU== 5 ;BUFFER HEADER FOR READTEXT
W== 6 ;WORKING REGISTER FOR XCT'S
J== 14 ;USED IN CHAR ROUTINE CALLS
K== 2 ;USED IN LSTOUT CALLS
L== 10 ;USED IN LSTMES CALLS
N== 11 ;CHAR AND LSTOUT JSP ACCUMULATOR
OPDEF PJRST [JRST] ;
SUBTLE <FLAG BITS>
XLIST
IFE BLIS11, <
LIST
;COMPILER AND EXECUTIVE FLAGS
;FLAGS SET BY EXEC, USED BY COMPILER (LEFT HALF OF AC F)
PROFLG== 1 ; PUT PROLOGS/EPILOGS IN THIS MODULE
CCLFLAG== 2 ; "CCL" DECLARATION
TTFLAG== 4 ; /T SWITCH
GRFLG== 10 ; LOAD ALL ROUTINES AS GLOBAL
EMFLAG== 20 ; ENABLE EXPAND MACRO TRACE
NPTFLG== 40 ; NO-OPTIMIZE FLAG
SFLAG== 100 ; PRINT STATS FOR B-L-I-M-P
IFLAG== 200 ; OUTPUT LUNDE DESCRIPTORS
SRFLG== 400 ; SAVE/RESTORE REGS AT EXCHJ
BINFLG== 1000 ; SUPPRESS BINARY OUTPUT
LSTFLG== 2000 ; SUPPRESS LISTING OUTPUT
TWOFLG== 4000 ; GENERATE GLOBALS IN LOWSEG
MFLAG== 10000 ; OUTPUT MACHINE CODE LISTING
CANLST== 20000 ; NO LISTING FILE AVAILABLE
HGHFLG== 40000 ; HISEG VERSION
FSAVFLG== 100000 ; FORCE SAVING OF FREG ON ROUTINE ENTRY
FINFLG== 200000 ; ALL SOURCE FILES READ
XREF== 400000 ; PRINT BLISS XREF
;FLAGS SET AND USED ONLY BY THE EXEC (RIGHT HALF OF AC F)
DEVBIT== 1 ; DEVICE SEEN IN COMMAND STRING
; ??????== 2 ; UNASSIGNED
ARWBIT== 4 ; LEFT ARROW SEEN
EXTBIT== 10 ; EXPLICIT EXTENSION NAME SEEN
SWTBIT== 20 ; ENTER SWITCH MODE
CHRBIT== 40 ; SPECIAL CALL FROM CHAR ROUTINE
INFOBIT== 100 ; VALID INFORMATION SEEN
ERRBIT== 200 ; SUPPRESS ERRORS ON TTY
FUNNY== 400 ; CMU SOS PAGE FLAG
NAMBIT== 1000 ; NAME SEEN IN COMMAND STRING
TTYLST== 2000 ; LISTING DEVICE IS A TTY
CMDLIN== 4000 ; HAVE A COMMAND LINE IN THE BUFFER
ENDBIT== 10000 ; END OF ALL INPUT FILES
SLSHBIT== 20000 ; SWITCH MODE ENTERED WITH </>
; ??????== 40000 ; UNASSIGNED
; ??????== 100000 ; UNASSIGNED
UNBIT== 200000 ; COMPLEMENT SWITCH
CCLBIT== 400000 ; COMMAND STRING FROM CCL FILE
INITFLGS==BINFLG+LSTFLG+CANLST+TWOFLG+SRFLG
XLIST >
IFN BLIS11, <
LIST
;COMPILER AND I/O ROUTINE FLAGS
;
;LEFT HALF OF AC F
; FLAGS SET BY SWITCHES IN COMMAND STRING
;
; ??????== 1 ; UNASSIGNED
EMFLG== 2 ;1-LIST MACRO EXPANSIONS
NPTFLG== 4 ;1-NO-OPTIMIZE FLAG
SFLG== 10 ;1-LIST COMPILER STATISTICS
BINFLG== 20 ;1-SUPPRESS BINARY OUTPUT
LSTFLG== 40 ;1-SUPPRESS LISTING OUTPUT
MLFLG== 100 ;1-LIST MACHINE CODE
PICSW== 200 ;1-PRODUCE POS. INDEPENDENT CODE
XREFLG== 400 ;1-PRODUCE BLISS XREF LISTING
ERRBIT== 1000 ;1-SUPPRESS ERROR PRINT OUTS ON TTY
;
;RIGHT HALF OF AC F
; FLAGS SET AND USED MOSTLY BY THE I/O ROUTINES
;
DEVBIT== 1 ;1-DEVICE SEEN IN COMMAND STRING
; ??????== 2 ; UNASSIGNED
ARWBIT== 4 ;1-LEFT ARROW SEEN
EXTBIT== 10 ;1-EXPLICIT EXTENSION NAME SEEN
SWTBIT== 20 ;1-ENTER SWITCH MODE
CHRBIT== 40 ;1-SPECIAL CALL FROM CHAR ROUTINE
INFOBIT== 100 ;1-VALID INFORMATION SEEN
FINFLG== 200 ;1-ALL SOURCD FILES READ
; ??????== 400 ; UNASSIGNED
NAMBIT== 1000 ;1-NAME SEEN IN COMMAND STRING
TTYLST== 2000 ;1-LISTING DEVICE IS A TTY
TTYONB== 4000 ;1-TTY HAS BEEN INITIALIZED
ENDBIT== 10000 ;1-END OF ALL INPUT FILES
SLSHBIT== 20000 ;1-SWITCH MODE ENTERED WITH </>
; ??????== 40000 ; UNASSIGNED
FUNNY== 100000 ;1-IF PROCESSING FUNNY SOS EDITOR PAGE MARK
UNBIT== 200000 ;1-COMPLEMENT SWITCH
CCLBIT== 400000 ;1-COMMAND STRING FROM CCL FILE
INITFLGS==BINFLG+LSTFLG
EXTERNAL NOTREE ;TRUE IFF SYNTAX ONLY
>
LIST
SUBTLE <INITIALIZATION>
RENBIO: MOVEM N,BIO ;STORE RETURN ADDRESS
F4EXEC: RESET ;INITIALIZE ALL IO DEVICES
HRLZ T, .JBREL ;PUT HIGHEST ADDRESS IN LEFT HALF
HRR T, .JBFF ;BEGINNING OF IMPURE AREA IN RH
HRLZI P, XP-XA ;GET A COUNT FOR PUSHDOWN LIST
HRRI P, XP-1(T) ;GET PUSHDOWN LIST ADDRESS
MOVEI F, 0 ;INITIALIZE SWITCHES
TLO F, INITFLGS
SETZM DEBFLG
SETZM SAVBLK
SKIPE CCLCTL ; CCL SWITCH SET?
TRO F,CCLBIT ; YES...SET CCL CONTROL BIT
MOVE B,BLANKS ;BLANK OUT SEQUENCE NO. FIELD
MOVEM B,SEQNUM(T)
MOVEI B, REQFST-1
MOVEM B,REQCHN ;INITIAL REQUIRE CHANNEL (MINUS ONE)
IFE BLIS11,<SETZM RPAGE>
SETZM SOSPGC
AOS SOSPGC
SETZM PPNPERM ; CLEAR PPN
MOVE B,NAME1
MOVEM B,TTLBUF(T)
MOVE B,NAME2
MOVEM B,TTLBUF+1(T)
;THE RESTRT ROUTINE PERFORMS THE FOLLOWING TASKS BEFORE BEGINNING
;A NEW COMPILATION:
; 1. OBTAINS THE DATE AND TIME FROM THE MONITOR
; 2. SETS THE LINE COUNT AND PAGE COUNT FOR THE LISTING
; FILE TO ZERO
; 3. FILLS THE TITLE BUFFER WITH ASCII BLANKS
; 4. INITIALIZES THE FLAG AC BY CLEARING ALL BITS, THEN
; SETTING BITS FOR SUPPRESSION OF BIN AND LST OUTPUT
; 5. CLEARS THE DEVICE CHANNEL NUMBER ACCUMULATOR
; 6. INITIALIZES THE SWITCH BUFFER COUNTER TO ZERO
;THE SECTION OF CODING JUST PRIOR TO GETLIN UPDATES .JBFF SO
;THAT IT WILL POINT TO THE BEGINNING OF THE IO BUFFERS - I.E.
;ROOM IS MADE FOR THE JOB DATA AREA, THE EXEC FIXED TABLES,
;AND THE COMPILER VARIABLE DATA AREA.
; REFERENCES ARE MADE TO .JBFF INDEXED BY AC 16.
;.JBFF ITSELF IS LEFT UNALTERED EXCEPT DURING TEMPORARY CALLS
;TO THE MONITOR FOR INBUFS AND OUTBUFS. THE ACTUAL UPDATED
;STATE OF .JBFF IS LEFT IN REGISTER XA+F IN THE IMPURE AREA .
HRRZ A, .JBFF
ADDI A, 140
HRRM A, TTOBUF
ADDI A, 30
HRRM A,XA+F(T)
HRLI V, T ;SET UP AC V FOR INDEXING
SETOM PAGCNT(T) ;INITIALIZE THE PAGE NUMBER
DATE A, ;GET THE DATE FROM THE MONITOR
MOVEM A, XDATE(T) ;SAVE IT
SETZM BINFIL ; INDICATE WE ARE STARTING
MOVE A,PACCUM ; SAVE PACCUM POINTER
MOVEM A,SAVP ; IN CASE DEVICE SPECIFIED
SETZI D, ;
TRNE F,CCLBIT ; WE GOT CCL?
JRST CCLIN1 ; YES...SKIP PROMPT
IFN BLIS11,<PUSHJ P,EXPOUT ;EXPERIMENTAL MESSAGE>
MOVEI A, "*"
OUTCHR A ; GIVE PROMPT
JRST GETCH2 ; GO ON AND READ STUFF
CCLIN1: SETZM XB+14(T) ; BUFFER PTR _ 0
SETZM XB+16(T) ; CHAR COUNT _ 0
MOVE A,CCLBP ; GET BYTE POINTER
MOVEM A,XB+15(T) ; FAKE IT OUT
SUBTLE <COMMAND DECODE>
;EXEC COMMAND STRING DISPATCHING
;THIS ROUTINE PICKS UP CHARACTERS FROM THE EXEC TTY BUFFER AND
;DISPATCHES TO THE PROPER ROUTINE DEPENDING ON THE TYPE OF
;CHARACTER. A TABLE OF BYTES AND BYTE POINTERS ALLOWS EACH CHARAC-
;TER IN THE ASCII SET TO BE TREATED INDIVIDUALLY.
;THE ROUTINE MAY BE ENTERED AT GETCHR IF IT IS DESIRED TO
;ACCUMULATE A 6-LETTER SIXBIT SYMBOL IN AC S. SYMBOLS OF
;DIFFERENT LENGTHS MAY BE ACQUIRED BY SETTING THE CONTENTS OF
;AC B TO THE DESIRED LENGTH AND ENTERING AT GETCH1.
GETCH2: SETZM PPNVAL ; CLEAR LAST TTEMP PPN
TRZ F, DEVBIT!EXTBIT
GETCHR: MOVEI B, 6 ;INITIALIZE SYMBOL LENGTH COUNTER
GETCH1: MOVEI S, 0 ;INITIALIZE SYMBOL ACCUMULATOR
TRZ F, NAMBIT
MOVE E, SYMPTR ;INITIALIZE SYMBOL BYTE AC
GETCMN: PUSHJ P, CMDCHR ; GET CHARACTER
JUMPN A, GETCM0 ; NULL?
TRNE F, CCLBIT ; YES - IN CCL?
EXIT ; YES - DONE
GETCM0: MOVE G, A ;ANOTHER COPY OF IT IN AC G
IDIVI G, 11 ;TRANSLATE TO 4-BIT CODE
LDB G, TABLE(H) ;USE PROPER BYTE POINTER
CAIN G, 17 ;IGNORE THIS CHARACTER?
JRST GETCMN ;YES
CAIGE G, 5 ;MODIFY CODE IF .GE. 5
JRST .+3
TRNE F, SWTBIT ;CODE .GE. 5 IN SWITCH MODE IS ILLEGAL
JRST ERR1
TRNN F, SWTBIT ;MODIFY CODE IF SWITCH MODE
ADDI G, 5
HRRZ H, DSPTCH(G) ;LOAD RIGHT HALF DISPATCH
CAIL G, 12 ;SKIP IF CORRECT
HLRZ H, DSPTCH-12(G) ;GET LEFT HALF DISPATCH
JRST @H ;EXIT
;COMMAND DISPATCH TABLE AND BYTE POINTERS
DSPTCH: XWD SWTCH,ERR1 ;<(>, BAD CHAR(SWITCH)
XWD COLON,SWTCHA ;<:>, LETTER(SWITCH)
XWD PERIOD,ERR1 ;<.>, NUMBER(SWITCH)
XWD LFTARW,SWTCHE ;<_> OR <=>, <)> ESCAPE SWITCH MODE
XWD COMMA,UNSWITCH ;<,>, <-> NOT(SWITCH)
XWD CARRTN,ERR2 ;<CR>, BAD CHAR(NORMAL)
XWD SLASH,STORE ;</>, LETTER(NORMAL)
XWD CCLLINK,STORE ;<!> OR <#>, NUMBER(NORMAL)
XWD 0,ERR2 ;<@>, <)> ILLEGAL ESCAPE
XWD PPN,ERR2 ;<[>, <-> ILLEGAL NOT
TABLE: POINT 4, BITE(G), 3
POINT 4, BITE(G), 7
POINT 4, BITE(G), 11
POINT 4, BITE(G), 15
POINT 4, BITE(G), 19
POINT 4, BITE(G), 23
POINT 4, BITE(G), 27
POINT 4, BITE(G), 31
POINT 4, BITE(G), 35
;BYTE TABLE FOR DISPATCHING
;CLASSIFICATION BYTE CODES
; BYTE DISP CLASSIFICATION
; 00 00 ILLEGAL CHARACTER, SWITCH MODE
; 01 01 ALPHABETIC CHARACTER, SWITCH MODE
; 02 02 NUMERIC CHARACTER, SWTICH MODE
; 03 03 SWITCH MODE ESCAPE, SWITCH MODE
; 04 04 NOT CHARACTER, <->, SWITCH MODE
; 00 05 ILLEGAL CHARACTER, NORMAL MODE
; 01 06 ALPHABETIC CHARACTER, NORMAL MODE
; 02 07 NUMERIC CHARACTER, NORMAL MODE
; 03 10 SWITCH MODE ESCAPE, NORMAL MODE
; 04 11 NOT CHARACTER, <->, NORMAL MODE
; 05 12 ENTER SWITCH MODE WITH A <(>
; 06 13 DEVICE DELIMITER, <:>
; 07 14 FILE EXTENSION DELIMITER, <.>
; 10 15 OUTPUT SPEC. DELIMITER, <_> OR <=>
; 11 16 FILE DELIMITER, <,>
; 12 17 COMMAND TERMINATOR, VERT. MOVEMENT CHAR OR ALT
; 13 20 ENTER SWITCH MODE WITH </>
; 14 21 CCL FILE DELIMITER, <!> OR <#>
; 15 22 -RESERVED- FOR INDIRECT FILE <@>
; 16 23 START PPN, <[>
; 17 -- IGNORED CHARACTER
;BYTE TABLE:
BITE: BYTE (4) 17,0,0,0,0,0,0,0,17
BYTE (4) 17,12,12,12,17,0,0,0,0
BYTE (4) 0,0,0,0,0,0,0,0,12
BYTE (4) 12,0,0,0,0,17,14,17,14
BYTE (4) 0,0,0,0,5,3,0,0,11
BYTE (4) 4,7,13,2,2,2,2,2,2
BYTE (4) 2,2,2,2,6,0,0,10,0
BYTE (4) 0,0,1,1,1,1,1,1,1
BYTE (4) 1,1,1,1,1,1,1,1,1
BYTE (4) 1,1,1,1,1,1,1,1,1
BYTE (4) 1,16,0,0,0,10,0,0,0
BYTE (4) 0,0,0,0,0,0,0,0,0
BYTE (4) 0,0,0,0,0,0,0,0,0
BYTE (4) 0,0,0,0,0,0,0,0,12
BYTE (4) 0,17
;THE FOLLOWING TWO ROUTINES HANDLE ALPHANUMERIC CHARACTERS
;FOUND IN THE COMMAND STRING. IN NORMAL MODE, THE CHARACTER
;IS DEPOSITED TO FORM A SIXBIT SYMBOL. IN SWITCH MODE, THE
;PROPER INSTRUCTION IS EXECUTED WITH THE AID OF A DISPATCH
;TABLE. THEN, IF SWITCH MODE WAS ENTERED WITH A SLASH, THE
;EXEC EXITS FROM SWITCH MODE. ALSO, IF THE SWITCH BEING PRO-
;CESSED IS IN A STANDARD DEFINITION, THE CHARACTER IS STORED.
STORE: TRO F, INFOBIT+NAMBIT ;TURN ON BIT FOR CR ROUTINE
SKIPN BINFIL ; IF BIN FILE ID WE SAVE
IDPB A,PACCUM ; THE CHARS AS THE MODULE NAME
; THIS MIGHT BE THE DEVICE NAME
; BUT IF WE HIT ":" WE WILL RESET IT
SOJL B, GETCMN ;JUMP IF NO ROOM FOR CHAR
SUBI A, 40 ;CONVERT FROM ASCII TO SIXBIT
IDPB A, E ;STORE CHARACTER IN E
JRST GETCMN ;RETURN FOR NEXT CHARACTER
SUBTLE <SWITCH PROCESSOR>
SWTCHA: TRO F, INFOBIT ;TURN ON FLAG FOR C.R.
MOVE G, A ;MOVE SWITCH CHARACTER INTO SCRATCH REG 2/16/78
TRNE F,UNBIT ; ARE WE COMPLEMENTING A SWITCH? 2/16/78
ADDI G,^D26 ; YES--USE SECOND DISPATCH TABLE
XCT SLIST-101(G) ;EXECUTE PROPER SWITCH INSTRUCTION
TRZ F,UNBIT ;CLEAR COMPLEMENT BIT 2/16/78
TRZE F, SLSHBIT ;CALLED BY A SLASH?
TRZ F, SWTBIT ;YES, EXIT FROM SWITCH MODE
JRST GETCMN ;RETURN FOR MORE CHARACTERS
;THE FOLLOWING THREE ROUTINES HANDLE THE CONTROL CHARACTERS
;IN THE COMMAND STRING WHICH CAUSE THE EXEC TO ENTER INTO AND
;EXIT FROM SWITCH MODE. THERE ARE TWO TYPES OF SWITCH MODE,
;DEPENDING ON WHETHER IT IS ENTERED WITH A </> OR A <(>.
SLASH: TRO F, SLSHBIT ;ENTER SWITCH MODE WITH A </>
SWTCH: TROA F, SWTBIT ;ENTER SWITCH MODE WITH A <(>
SWTCHE: TRZ F, SWTBIT ;EXIT FROM SWITCH MODE WITH A <)>
JRST GETCMN ;RETURN FOR MORE CHARACTERS
UNSWITCH:TROE F, UNBIT ;TURN ON NOT INDICATOR
JRST ERR1 ;ILLEGAL IF ALREADY ON
JRST GETCMN ;RETURN FOR MORE CHARACTERS
XLIST
IFE BLIS11,<
LIST
SUBTLE <SWITCH DISPATCH TABLES>
;DISPATCH TABLE
SLIST: SETZM NOENGLISH ;A - ENGLISH DIAGNOSTICS
SETOM STARTBLOCK ;B - PUT START BLOCK ON REL FILE
TLO F,XREF ;C - BLISS XREF PLEASE
PUSHJ P,DEBON ;D - DEBUG LINKAGE ON
TLO F,EMFLAG ;E - ENABLE EXPAND MACRO FLAG
TLO F,FSAVFLG ;F - SAVE FREG
TLO F,GRFLG ;G - LOAD ALL ROUTINES AS GLOBAL
TLC F,TWOFLG+HGHFLG ;H - HIGH SEGMENT PROGRAM FILE
TLO F,IFLAG ;I - LUNDE DESCRIPTORS
JRST ERR1 ;J - ERROR
TLO F,LSTFLG ;K - KILL THE LISTING
TLZ F,LSTFLG ;L - ENABLE LISTING
TLO F,MFLAG ;M - MACHINE LANG. LIST ENABLE
TRO F,ERRBIT ;N - SUPPRESS ERRORS TO TTY
TLZ F,NPTFLG ;O - OPTIMIZE SWITCH
TLO F,PROFLG ;P - PROLOGS IN THIS MODULE
SETOM XR1COM ;Q - WITH /C MAKES COMPACT XREF
TLZ F,SRFLG ;R - NO SAV/RESTORE AT EXCHJ
TLO F,SFLAG ;S - B-L-I-M-P STATS
PUSHJ P,TENABLE ;T - ENABLE TRACE/TIMING
TLO F,NPTFLG ;U - NO OPTIMIZATION
TLC F,TWOFLG ;V - LOW SEGMENT PROGRAM FILE
JRST ERR1 ;W - ERROR
SETZM CODETOG ;X - SYNTAX CHECK ONLY SWITCH
JRST ERR1 ;Y - ERROR
SETOM ZFLAG ;Z - OUTPUT INTO REL SREG,VREG,FREG,DREGS,RESREGM
;COMPLEMENT DISPATCH TABLE
SETOM NOENGLISH ; -A - MNEMONIC ERROR MESSAGES ONLY
JRST ERR1 ; -B - ERROR
TLZ F,XREF ; -C - TURN OFF XREF
SETZM DEBFLG ; -D - DEBUG LINKAGE OFF
TLZ F,EMFLAG ; -E - DON'T EXPAND MACROS
TLZ F,FSAVFLG ; -F - DON'T FORCE SAVING OF FREG
TLZ F,GRFLG ; -G - DO NOT LOAD LOCAL ROUTINES AS GLOBAL
JRST ERR1 ; -H - CANNOT DISABLE /H
TLZ F,IFLAG ; -I - NOINSPECT
JRST ERR1 ; -J - ERROR
JRST ERR1 ; -K - ERROR
TLO F,LSTFLG ; -L - TURN OFF LISTING
TLZ F,MFLAG ; -M - TURN OFF MACHINE CODE
TRZ F,ERRBIT ; -N - RE-ENABLE ERRORS TO TTY
TLO F,NPTFLG ; -O - NO OPTIMIZATION
JRST ERR1 ; -P - ERROR
JRST ERR1 ; -Q - ERROR
TLO F,SRFLG ; -R - YES SAV/RESTOR AT EXCHJ
TLZ F,SFLAG ; -S - NO B-L-I-M-P STATS
PUSHJ P,TDISABLE ; -T - NO TRACE/TIMING
JRST ERR1 ; -U - ERROR
JRST ERR1 ; -V - CANNOT DISABLE /V
JRST ERR1 ; -W - ERROR
JRST ERR1 ; -X - CANNOT RE-ENABLE CODE GEN.
JRST ERR1 ; -Y - ERROR
SETZM ZFLAG ; -Z - DONOT OUTPUT SREG,VREG,FREG,DREGS,RESREGM INTO REL
DEBON: SETOM DEBFLG ; TURN ON DEBUG FLAG
TLO F,FSAVFLG ; ALSO MUST DO /F
POPJ P,
TENABLE:TLO F,TTFLAG ; TURN ON TTFLAG
MOVEI A,1 ; AND MHTIME
MOVEM A,MHTIME ; ...
POPJ P,
TDISABLE:TLZ F,TTFLAG ; TURN OFF TTFLAG
SETZM MHTIME ; AND MHTIME
POPJ P,
XLIST >
IFN BLIS11,<
LIST
SUBTLE <SWITCH DISPATCH TABLES>
;DISPATCH TABLE
SLIST: JRST ERR1 ;A - ERROR
JRST ERR1 ;B - ERROR
TLO F, XREFLG ;C - BLISS XREF PLEASE
JRST ERR1 ;D - ERROR
TLO F, EMFLG ;E - LIST MACRO EXPANSIONS
JRST ERR1 ;F - ERROR
JRST ERR1 ;G - ERROR
JRST ERR1 ;H - ERROR
JRST ERR1 ;I - ERROR
JRST ERR1 ;J - ERROR
JRST ERR1 ;K - ERROR
TLZ F, LSTFLG ;L - ENABLE LISTING
TLO F, MLFLG ;M - ENABLE MACH. LANG. LISTING
TLO F, ERRBIT ;N - SUPPRESS ERRORS TO TTY
TLZ F, NPTFLG ;O - OPTIMIZE
TLO F, PICSW ;P - POSITION INDEPENDENT CODE
JRST ERR1 ;Q - ERROR
JRST ERR1 ;R - ERROR
TLO F, SFLG ;S - LIST COMPILER STATISTICS
JRST ERR1 ;T - ERROR
JRST ERR1 ;U - ERROR
JRST ERR1 ;V - ERROR
JRST ERR1 ;W - ERROR
SETOM NOTREE ;X - SYNTAX CHECK ONLY
JRST ERR1 ;Y - ERROR
JRST ERR1 ;Z - ERROR
;COMPLEMENT DISPATCH TABLE
JRST ERR1 ; -A - ERROR
JRST ERR1 ; -B - ERROR
TLZ F, XREFLG ; -C - TURN OFF XREF
JRST ERR1 ; -D - ERROR
TLZ F, EMFLG ; -E - TURN OFF MACRO EXPANSION LISTING
JRST ERR1 ; -F - ERROR
JRST ERR1 ; -G - ERROR
JRST ERR1 ; -H - ERROR
JRST ERR1 ; -I - ERROR
JRST ERR1 ; -J - ERROR
JRST ERR1 ; -K - ERROR
TLO F, LSTFLG ; -L - TURN OFF LISTING
TLZ F, MLFLG ; -M - TURN OFF MACH. CODE LISTING
TLZ F, ERRBIT ; -N - RE-ENABLE ERRORS TO TTY
TLO F, NPTFLG ; -O - NO OPTIMIZATION
TLZ F, PICSW ; -P - DON'T BOTHER WITH POSITION IND. CODE
JRST ERR1 ; -Q - ERROR
JRST ERR1 ; -R - ERROR
TLZ F, SFLG ; -S - STOP LISTING COMPILER STATISTICS
JRST ERR1 ; -T - ERROR
JRST ERR1 ; -U - ERROR
JRST ERR1 ; -V - ERROR
JRST ERR1 ; -W - ERROR
JRST ERR1 ; -X - CANNOT RE-ENABLE CODE GEN.
JRST ERR1 ; -Y - ERROR
JRST ERR1 ; -Z - ERROR
>
LIST
SUBTLE <RUN (! OR #) REQUEST>
; THIS ROUTINE PROCESSES THE "!" AND "#" RUN REQUESTS
IFE NONREN, <RELOC>
CCLLIN: SKIPN BINFIL ;IS THIS FIRST FILE SPECIFICATION
TRNN F, INFOBIT ;AND WAS SOMETHING SEEN
JRST ERR2 ;NO, ERROR
CAIE A,"!" ; CCL (!) OR DIRECT (#) ENTRY
TLZA S-2,-1 ; CLEAR LEFT AND SKIP (FOR #)
MOVSI S-2,1 ; SET LEFT TO 1 (FOR !)
HRRI S-2,S-1 ; POINTER TO CONTROL BLOCK
HRLZI S-1,(SIXBIT /SYS/);SET UP DEFAULT DEVICE
TRNE F, DEVBIT ;WAS A DEVICE SPECIFIED?
MOVE S-1, XE+1(T) ;YES, USE IT
SETZ S+1, ;ZERO EXTENSION
SETZB S+2, S+4 ;ZERO OTHER CRUD
TRNE F, EXTBIT ;WAS EXTENSION SPECIFIED
HLL S+1, XE+4(T) ;YES, USE IT
SKIPN S+3, PPNVAL ;USE PPN IF THERE IS ONE
MOVE S+3, PPNPERM
MOVEI 0, CCLAST ; SAVE ONLY WHAT'S NECESSARY
CORE 0,
JFCL ; IGNORE ERROR RETURN
RUN S-2,
CCLAST: HALT . ; WE BLEW IT
IFE NONREN, <RELOC>
SUBTLE <PPN PROCESSING>
PPN: PUSH P,E ; SAVE E
PUSH P,S ; SAVE S
PUSH P, S+1 ;SAVE S+1
PUSH P, S+2
SETZM PPNBUFF ;CLEAR PPN BUFFER
SETZM PPNBUFF+1
SETZM PPNBUFF+2
MOVE S, [POINT 7,PPNBUFF]
IFN CMUSW,<
MOVE A, XB+15(T) ;COPY INPUT BUFFER POINTER
ILDB A, A
CAIL A, "0" ;IS FIRST CHAR OCTAL DIGIT?
CAILE A, "7"
JRST PPNCMU ;NO SO THIS IS CMU PPN >
SETZ S+2, ;COLLECT DEC PPN
PPNL1: MOVEI S+1,6
SETZ E,
PPNLOOP: PUSHJ P, CMDCHR ; GET A CHARACTER
CAIN A,"]" ; END OF PPN?
JRST PPNGOT ; YES---WE GOT ONE
IDPB A, S ;SAVE THE CHAR IN THE PPN BUFFER
CAIN A,"," ; IS IT A ","?
JRST PPNCOM ; YES---PROCESS IT
SOJL S+1,ERR4
CAIL A,"0"
CAILE A,"7"
JRST PPNERR
LSH E, 3
ADDI E, -"0"(A) ; ADD NEXT CHARACTER
HRRM E,PPNVAL
JRST PPNLOOP
PPNCOM: JUMPN S+2,PPNERR
MOVSS PPNVAL
MOVEI S+2,1
JRST PPNL1
PPNGOT: TRNE F,DEVBIT+EXTBIT+NAMBIT ;ANYTHING BEFORE THIS?
JRST PPNTMP ; YES---TEMPORARY PPN
MOVE S,PPNVAL ; GET THE PPN
MOVEM S,PPNPERM ; MAKE IT PERMANENT
PPNTMP: POP P, S+2
POP P,S+1 ; RESTOR S+1
POP P,S ; RESTORE S
POP P,E ; RESTORE E
JRST GETCMN
IFN CMUSW,<
PPNCMU: MOVEI S+1, 10 ;MAX NO. OF CHARS PER PPN
PPNCM1: PUSHJ P, CMDCHR ; GET A CHARACTER
CAIN A, "]" ;END OF PPN?
JRST PPNCVT ;YES, GO CONVERT IT
SOJL S+1, ERR4
IDPB A, S
CAIL A, "0" ;CHAR MUST BE ALPHABETIC OR NUMERIC
CAILE A, "Z"
JRST PPNERR
CAILE A, "9"
CAIL A, "A"
JRST PPNCM1
JRST PPNERR
PPNCVT: HRRI S, PPNBUFF ;CONVERT PPN TO DEC PPN
HRLI S, PPNVAL
CALL S, [SIXBIT /CMUDEC/]
JRST PPNERR
JRST PPNGOT >
SUBTLE <PROCESSORS FOR CR/LF,"_","=",".",":">
;SUBROUTINE TO HANDLE THE OUTPUT SPECIFICATION DELIMITER <_>
;OR <=>. THE ROUTINE DOES A LOOKUP ON THE FILE NAME PRECEDING
;IT, IF NECESSARY, SINCE THE <_> ACTS ALSO AS A FILE NAME
;DELIMITER. THE CHANNEL NUMBER IS RESET FOR INPUT.
LFTARW: AOS BINFIL ; INDICATE WE HAVE FINISHED REL AND LST FILES
IFN BLIS11,<
MOVEI D, 1 ;TEMPORARILY MAKE SINGLE FILE BE LISTING FILE
>
PUSHJ P,LOOKUP ; YES---GO LOOK IT UP
MOVEI D,2 ; SDT D FOR INPUT
TRO F,ARWBIT ; SET FLAGS
JRST GETCH2 ; RETURN FOR NEXT SPEC
;SUBROUTINE TO HANDLE THE FILE NAME EXTENSION DELIMITER <.>
;THE EXTENSION BIT IS TURNED ON WHENEVER A PERIOD IS SEEN.
;THE FILE NAME IS STORED IN THE LOOKUP BLOCK, THE CHARACTER COUNTER
;IS RESET TO 3, AND GETCHR IS ENTERED TO COLLECT AN EXTENSION.
PERIOD: TROE F, EXTBIT ;TURN ON THE EXTENSION BIT
JRST ERR18 ; ALREADY SEEN
MOVEM S, XE+3(T) ;SAVE FILE NAME
MOVEI B, 3 ;SET COUNT TO 3
JRST GETCH1 ;GO COLLECT EXTENSION NAME
CARRTN: TRZ F, CMDLIN ; END OF TTY INPUT LINE
MOVE A,XB+15(T) ; GET BYTE POINTER
MOVEM A,CCLBP ; SAVE IT IN CASE WE'RE IN CCL MODE
TRNN F, INFOBIT ;ANY VALID INFORMATION SEEN?
JRST F4EXEC
TRO F, ENDBIT ;END OF ALL INPUT FILES
PUSHJ P, LOOKUP ; YES, DO A LOOKUP
TRNE F, ARWBIT ;TEST COMMAND STRING SYNTAX
CAIE D, 3 ;...
JRST ERR4 ;ERROR
CAR2: TRNN F,CCLBIT ; ARE WE IN CCL MODE?
JRST @BIO
OUTSTR PROCRM ; YES, GIVE MESSAGE
MOVE S,XE+3(T) ; FILE NAME
PUSHJ P,STYPO
MOVEI A,"." ; DOT
OUTCHR A
HLLZ S,XE+4(T) ; EXTENSION
PUSHJ P,STYPO ; TYPE IT TOO
OUTSTR [BYTE(7)15,12]
IFN BLIS11,<PUSHJ P,EXPOUT ;EXPERIMENTAL MESSAGE>
JRST @BIO ; DONE FINALLY.
IFN BLIS11,<
EXPOUT: SKIPE .JBDDT ;IS DDT LOADED?
POPJ P,0 ;YES - NO MESSAGE
MOVEI L,EXPMES
PJRST TTYMES >
PROCRM:
IFE BLIS11,< ASCIZ /BLISS: />
IFN BLIS11,< ASCIZ /BLIS11: />
;THE COLON ROUTINE IS CALLED WHENEVER THE EXEC FINDS A <:>
;IN THE COMMAND STRING. ROUTINE DEVINI IS CALLED BY VARIOUS
;PARTS OF THE EXEC TO CALCULATE BUFFER HEADERS AND PERFORM
;THE ACTUAL INITIALIZATION. A DEVICE MAY BE INITIALIZED AS
;FOLLOWS:
; PUSHJ P, DEVINI
; SIXBIT SYMBOL NAME IN AC S
; DESIRED CHANNEL NUMBER IN AC D
COLON: TROE F, DEVBIT ;COLON ALREADY SEEN?
JRST ERR4 ;YES, COMMAND ERROR
MOVEM S, XE+1(T) ;SAVE DEVICE NAME FOR LATER
JUMPN D, GETCHR ;IS THIS .REL FILE? NO, RETURN
MOVE A,SAVP ; YES...RESTOR PACCUM POINTER
MOVEM A,PACCUM ;
HRREI B,-2 ; NULL STRING VALUE
MOVEM B,0(A) ; CLEAR FIRST WORD OF PACCUM
MOVEM B,1(A) ; CLEAR SECOND WORD OF PACCUM
JRST GETCHR ; GO GET FILE NAME
SUBTLE <DEVICE INITIALIZATION>
DEVINI: MOVEI S+1, 3 ;CALCULATE BUF HEADER POS.
IMUL S+1, D ;...
ADDI S+1, XB(T) ;THIS IS THE TYPE 1 PART
MOVE G, S ;GET DEVICE CHARACTERISTICS
MOVEM S, XE+1(T) ;SAVE DEVICE FOR ERROR ROUTINES
DEVCHR G, ;GET DEVICE CHARACTERISTICS
JUMPE G, ERR11 ;NO SUCH DEVICE?
CAIN D, 1 ;CHECK TO SEE IF DEVICE CAN
TLNN G, 1 ;DO INPUT OR OUTPUT PROPERLY
TLNE G, -1(D) ;...
JRST @DEVLST-1(D) ;GOOD - GO
JRST ERR15 ;NOT-SO-GOOD
DEVINB: MOVSS S+1 ;SWAP HEADER FOR OUTPUT
DEVIN1: SETZI S-1, ; ASCII MODE
CAIN D, 1 ;IS THIS THE BINARY DEVICE?
MOVEI S-1, 10 ;YES, CHANGE MODE TO IMAGE
HRLZI S+2, (OPEN)
DPB D, [POINT 4,S+2,12] ; FORM OPEN UUO
HRRI S+2, S-1 ; ADR OF BLK
XCT S+2 ;
JRST ERR3 ; NO GOOD
MOVE B, XA+F(T) ;GET UPDATED .JBFF FROM BUFFER
EXCH B, .JBFF ;LET THE MONITOR PLAY WITH IT
MOVE A, [OUTBUF 1]
CAIN D, 3 ; INPUT DEVICE?
MOVE A, [INBUF 1]
DPB D, CHPTR ;SET UP THE CHANNEL NUMBER
XCT A ;EXECUTE THE OUTBUF OR INBUF
EXCH B, .JBFF ;PUT OLD .JBFF BACK AGAIN
MOVEM B, XA+F(T) ;SAVE NEW UPDATED .JBFF
POPJ P, ;DONE
;SECTION DEVIN4 INITIALIZES THE SOURCE DEVICE. IT TESTS THE
;SYNTAX OF THE COMMAND STRING FOR POSSIBLE ERRORS, AND PUTS
;THE BUFFER FOR THIS DEVICE ON TOP OF ANY PREVIOUS SOURCE
;DEVICES THAT MAY HAVE BEEN EXECUTED. A POINTER IS SAVED TO
;LOCATE THE POSITION OF THIS BUFFER. IF THE SOURCE DEVICE
;DOES NOT HAVE A DIRECTORY, THE SCAN OF THE COMMAND STRING IS
;STOPPED, AND CONTROL TRANSFERS TO THE CHAR ROUTINE.
;A CHECK IS ALSO MADE TO SEE IF THE DEVICE CAN BE PROPERLY
;INITIALIZED IN ASCII OR ASCII LINE MODE.
DEVIN4: TRNN F, ARWBIT
JRST ERR4 ;NO, ERROR CONDITION
HRRZ A, XA+F(T) ;RESET .JBFF FOR SOURCE DEVICE
MOVEM A, XB-1(T) ;SAVE IT
TRNN G, AMODE ;CAN DEVICE HANDLE ASCII MODE?
JRST ERR17 ;NO, ERROR
PJRST DEVIN1 ;INITIALIZE SOURCE DEVICE AND EXIT
;SECTION DEVIN5 INITIALIZES THE LISTING DEVICE. IT CHECKS TO
;SEE IF THE DEVICE IS A TELTYPE, AND, IF SO, SETS A FLAG FOR
;THE LSTOUT, LSTMES, ERROUT AND ERRMES ROUTINES
;THE ROUTINE ALSO CHECKS TO SEE IF THE DEVICE CAN BE PROPERLY
;INITIALIZED IN ASCII OR ASCII LINE MODE.
DEVIN5: TLNE G, TTYBIT ;YES, SET FLAG FOR IO ROUTINES
TRO F, TTYLST ;YES, SET FLAG FOR IO ROUTINES
TRNN G, AMODE ;CAN DEVICE HANDLE ASCII MODE?
JRST ERR17 ;NO, ERROR
TLZ F,LSTFLG+CANLST ; YES--TURN ON LIST AND CANLST FLAGS
JRST DEVINB ; AND GO ON
DEVIN6: TRNN G, BMODE ;CAN DEVICE HANDLE BINARY MODE?
JRST ERR17 ;NO, ERROR
TLZ F,BINFLG
IFN BLIS11,< POPJ P, ;TEMPORARILY IGNORE BINARY OUTPUT FILE>
JRST DEVINB
DEVLST: JRST DEVIN6 ;BINARY DISPATCH
JRST DEVIN5 ;LISTING OUTPUT
JRST DEVIN4 ;SOURCE INPUT
SUBTLE <PROCESSOR FOR ",">
;THE COMMA PROCESSOR
;THIS ROUTINE IS COMPOSED OF TWO PARTS, IN A MANNER SIMILAR TO
;THE DEVICE INITIALIZING ROUTINE; THE COMMA ROUTINE IS CALLED
;WHEN <,> IS SEEN IN THE COMMAND STRING. ROUTINE LOOKUP IS
;CALLED BY COMMA AND BY VARIOUS OTHER PARTS OF THE EXEC TO
;PERFORM LOOKUPS AND ENTERS ON THE DECTAPE.
COMMA: AOS BINFIL ; TURN OFF NAME ACCUMULATION
PUSHJ P, LOOKUP ; DO A LOOKUP
JRST GETCH2 ; GO TO NEXT ITEM
SUBTLE <LOOKUP/ENTER ROUTINE>
;THE LOOKUP ROUTINE CHECKS FOR NULL FILES IN THE COMMAND STRING
;AND DOES LOOKUPS AND ENTERS ON NON-NULL FILES. IF A FILE NAME
;EXTENSION WAS SPECIFIED, IT IS TAKEN. OTHERWISE, A STANDARD
;EXTENSION IS TAKEN. THE DATE IS ENTERED IN OUTPUT FILES. ON
;THE SOURCE DEVICE, THE ROUTINE DOES A LOOKUP, THEN HALTS THE
;SCAN OF THE COMMAND STRING BY RETURNING TO THE CARRIAGE RETURN
;ROUTINE. IF NO FILE NAME EXTENSION IS SPECIFIED FOR THE
;INPUT DEVICE, IT IS TAKEN TO BE <BLI> OR <B11>. IF THE LOOKUP FAILS,
;ANOTHER ATTEMPT IS MADE WITH A BLANK FILE NAME EXTENSION.
LOOKUP: AOJ D, ;INCREMENT DEVICE NO.
CAILE D, 3 ;RESET TO 3 INCASE OF MULT INPUT FILES
MOVEI D, 3
TRNN F, DEVBIT+EXTBIT+NAMBIT ;ANYTHING TO DO?
JRST LOOK3A ;NO, GO AWAY
PUSH P, S ;SAVE CURRENT SYMBOL
MOVE S, XE+1(T) ;GET DEVICE NAME
TRON F, DEVBIT ;DEVICE SPECIFIED?
HRLZI S, (SIXBIT /DSK/) ;NO, ASSUME DSK
PUSHJ P, DEVINI ;INITIALIZE DEVICE
POP P, S ;RESTORE SYMBOL
TRNE F, EXTBIT ;EXPLICIT EXTENSION SPECIFIED?
JRST LOOK3 ;YES
MOVEM S, XE+3(T) ;NO, SAVE THE FILE NAME
HLLZ S, LIST-1(D) ;GET PROPER EXTENSION NAME
LOOK3: MOVEM S, XE+4(T) ;SAVE FILE NAME EXTENSION
CAIE D,3 ;IS THIS A SOURCE DEVICE?
SETZM XE+5(T) ;NO--LET MONITOR SUPPLY DATE & TIME
SETZM XE+6(T) ;CLEAR FOURTH WORD OF BLOCK
SKIPN A,PPNVAL ; DO WE HAVE A PPN?
SKIPE A,PPNPERM ; NOT TEMP PPN. PERMANET PERHAPS?
MOVEM A,XE+6(T) ; YES---USE IT
IFN BLIS11,<
CAIN D, 1 ;TEMPORARILY IGNORE BIN FILE
JRST LOOK3A >
HRLI A, 077000 ;ENTER UUO
CAIN D, 3 ;IS IT AN INPUT DEVICE?
HRLI A, 076000 ;YES, GET LOOKUP UUO
DPB D, CHPTR ;LOAD THE CHANNEL NUMBER
HRRI A, XE+3(T) ;GET ADDRESS OF LOOKUP BLOCK
XCT A ;EXECUTE THE LOOKUP OR ENTER
JRST ERR5 ;FAILURE-LOOKUP OR ENTER
CAIN D,3 ; IS THIS A SOURCE FILE?
PUSHJ P,SAVSRC ; YES - SAVE THE LOOKUP BLOCK FOR DELETE
CAIN D,1 ;IS THIS BINARY FILE?
PUSHJ P,SAVBIN ;YES - SAVE LOOKUP BLOCK FOR RENAME
LOOK3A: CAIE D, 3 ;IS THIS THE SOURCE DEVICE?
POPJ P, ;NORMAL EXIT
POP P, A ;TERMINATE SCAN
TRZN F, CHRBIT ;CALLED BY INCHR ROUTINE?
JRST CAR2 ;NO, JUMP INTO CR PROCESSOR
POPJ P, ;YES, RETURN TO IT
SAVBIN: PUSH P,A ;SAVE AC
HRLI A,SAVBLK ;SET UP FOR BLT
MOVSS A ;AND SWAP
BLT A,SAVBLK+3 ;MOVE IT
POP P,A ;RESTORE
POPJ P, ;AND RETURN
SAVSRC: PUSH P,A ;SAVE AC
HRLI A,SRCBLK ;SET UP FOR BLT
MOVSS A ;AND SWAP
BLT A,SRCBLK+3 ;MOVE IT
POP P,A ;RESTORE
POPJ P, ;AND RETURN
LIST: SIXBIT /REL/
IFE BLIS11,< SIXBIT /LST/
SIXBIT /BLI/ >
IFN BLIS11,< SIXBIT /P11/
SIXBIT /B11/ >
XWD 0,0
XWD 0,0
SUBTLE <LST FILE OUTPUT ROUTINES>
;SUBROUTINE FOR OUTPUT ON THE LISTING FILE
;
;LIST2 DECREMENTS THE COUNT OF THE LISTING DEVICE BUFFER
;AND OUTPUTS A BUFFER WHEN REQUIRED. A CHECK IS MADE FOR THE
;OCCURRENCE OF DATA ERRORS AND DEVICE ERRORS.
;
;CALLS TO LIST2
; JSP N, LIST2
; CHARACTER RIGHT JUSTIFIED IN ACCUMULATOR K
LIST2: SOSG XB+10(T) ;DECREMENT ITEM COUNT
PUSHJ P, LIST1 ;EMPTY ENTIRE BUFFER
IDPB K, XB+3*2+1(T) ;STORE THE CHARACTER
JRST (N) ;EXIT
LIST1: OUTPUT 2, ;EMPTY A BUFFER
STATZ 2, IODATA+IODEV+IOBKTL ;CHECK FOR ERRORS
JRST ERR7 ;YES, GO COMPLAIN
POPJ P, ;NO, EXIT
;ROUTINE TO PRINT THE HEADER
HEDR: PUSHJ P,ACSAVE ;SAVE THE ACC'S
HRLI V, T ;PUT T IN INDEX PORTION OF V
MOVEI K, 14
JSP N, LIST2 ;OUTPUT IT
PUSHJ P, HDRSET
MOVE S,SOSPGC ;GET SOS PAGE NO.
SETZ C ; COUNT _ 0
PUSHJ P,NUMO2 ; PRINT IT
AOSG PAGCNT(T) ;INCREMENT PAGE COUNT
JRST HDR0 ;OLLY PRINT IT WHEN IT IS .GT. 0
MOVEI S,"-" ; PRINT A HYPHEN
IDPB S,B
MOVE S, PAGCNT(T) ;GET THE PAGE NUMBER
PUSHJ P, NUMO2 ;INSERT IT IN THE BUFFER
HDR0: MOVEI S, 0 ;MAKE IT AN ASCIZ MESSAGE
IDPB S, B ;BY STORING A NULL CHARACTER
MOVE L, TTPNT2 ;GET AN INDEXED BYTE POINTER
HDR1: ILDB K, L ;GET A CHARACTER
JUMPE K, HDR2 ;IS IT NULL?
JSP N, LIST2 ;NO, SO OUTPUT IT
JRST HDR1 ;CONTINUE
HDR2: MOVEI K, 15 ;OUTPUT CR AND 2 LF'S
JSP N, LIST2
MOVEI K, 12
JSP N, LIST2
JSP N, LIST2
TRNE F, TTYLST ;IS LISTING DEVICE A TELETYPE?
PUSHJ P, LIST1 ;YES, OUTPUT THE WHOLE LINE
PUSHJ P, ACREST ;RESTORE ACCUMULATORS
JRST (N) ;EXIT TO COMPILER
;THE FIRST PORTION OF THIS ROUTINE PRINTS THE STANDARD
;VERSION NUMBER OF THE CURRENT COMPILER. THE END OF THE ROUTINE
; PRINTS THE DATE, WHICH IS FOUND IN REGISTER XDATE(T) IN THE FORM
;
; ((Y-1964)*12 + (M-1))*31 + (D-1)
HDRSET: MOVE B, TTLPNT ;SET THE BYTE POINTER IN AC B
IFE BLIS11,<MOVEI C,6> ;COUNT _ 6
IFN BLIS11,<SETZ C> ;COUNT _ 0
LDB S, MAJVBP ; MAJOR VERSION NUMBER
PUSHJ P, OCTOUT
LDB S, MINVBP ; MINOR VERSION NUMBER
JUMPE S, HDRS1 ; DON'T GIVE IT IF ZERO
ADDI S, 100 ; TO ASCII
IDPB S, B
HDRS1: MOVEI S, "("
IDPB S, B
HRRZ S, .JBVER ; GET EDIT NUMBER
PUSHJ P, OCTOUT
MOVEI S, ")"
IDPB S, B
LDB S, WHOBP ; LAST EDITOR
JUMPE S, HDRS2
MOVEI S+1, "-"
IDPB S+1, B
PUSHJ P, OCTOUT
HDRS2: MOVEI S, 40
IDPB S, B
MOVEI S,11 ;PUT IN A TAB
IDPB S,B
MOVE R, XDATE(T) ;GET THE DATE IN R
IDIVI R, 37 ;DIVIDE BY 31 DECIMIAL
PUSH P, S ;(D-1) IS REMAINDER, SAVE IT
IDIVI R, 14 ;DIVIDE BY 12 DECIMAL
PUSHJ P, DATOUT ;OUTPUT THE MONTH, (M-1) IS IN S
POP P, S ;RECOVER (D-1)
PUSHJ P, DATOUT ;OUTPUT THE DAY
MOVE S, R ;GET (Y-1964)
ADDI S, 100 ;GET YEAR
PUSHJ P, NUMOUT ;TYPE IT
MOVEI K, 40 ;OUTPUT TWO SPACES AND A TAB
IDPB K, B ;...
IDPB K, B
MOVEI K, 11 ; TAB
IDPB K, B
;THE FOLLOWING SECTION OF CODE PRINTS THE TIME, WHICH IS
;RETRIEVED FROM THE MONITOR AS THE NUMBER OF MILLISECONDS
;SINCE MIDNIGHT. THE FORMAT OF THE TIME PRINTOUT IS
;HH:MM.SS
MSTIME R,
IDIVI R, ^D1000 ;TIME IN SECONDS NOW IN R
IDIVI R, ^D60 ;EXCESS SECONDS IN S
PUSH P, S ;SAVE THE SECONDS
IDIVI R, ^D60 ;MINUTES IN S
PUSH P, S ;SAVE THE MINUTES
MOVE S, R ;GET HOURS IN S
PUSHJ P, NUMOUT ;OUTPUT THE HOURS
MOVEI K, ":" ;OUTPUT A COLON AFTER THE HOURS
IDPB K, B ;...
POP P, S ;RECOVER THE MINUTES
CAIL S, ^D10
JRST .+3
MOVEI K, "0"
IDPB K, B ; LEAD ZERO IF NECESSARY
PUSHJ P, NUMOUT ;OUTPUT THE MINUTES
MOVEI K, ":"
IDPB K, B ;...
POP P, S ;RECOVER THE SECONDS
CAIL S, ^D10
JRST .+3
MOVEI K, "0"
IDPB K, B ;
PUSHJ P, NUMOUT ;OUTPUT THE SECONDS
MOVEI K, 40
IDPB K, B
MOVEI K, 11 ;OUTPUT A TAB
IDPB K, B ;...
; IF NOT A TTY, THEN PRINT THE FILE NAME
TRNE F,TTYLST
JRST HDRNF ; IF TTY, THEN NO LIST
IDPB K,B ; ANOTHER TAB
MOVEI S,6 ; COUNT OF CHARS
HRRI R,XE+3(T) ; POINT TO FILE NAME
HRLI R,440600 ; SIXBIT POINTER
PUSHJ P,HDRSIX ; PRINT IT
MOVEI K,"." ; DOT
IDPB K,B ; ...
MOVEI S,3 ; COUNT
HRRI R,XE+4(T) ; POINT TO EXTENSION NAME
HRLI R,440600 ; SIXBIT POINTER
PUSHJ P,HDRSIX ; PRINT IT
MOVEI K,11
IDPB K,B
IDPB K,B ; ANOTHER TAB
HDRNF:
;THE FINAL SECTION OF CODING PICKS UP THE WORD "PAGE " AND
;STORES IT IN THE PROPER PLACE IN THE TITLE BUFFER.
MOVEI S, 5 ;COUNTER FOR FIVE CHARACTERS
MOVE R, PGEPTR ;GET BYTE POINTER TO "PAGE "
ILDB K, R ;PICK UP A CHARACTER
IDPB K, B ;STORE IT
SOJG S, .-2 ;LOOP FOR MORE CHARACTERS
POPJ P, ;EXIT
;ROUTINES DATOUT AND NUMOUT ASSIST IN OUTPUTTING THE
;NUMERICAL PARTS OF THE HEADER
DATOUT: AOS S ;GET MONTH OR DAY
PUSHJ P, NUMOUT ;OUTPUT THE NUMBER
MOVEI K, "/" ;GET A SLASH FOR DTAE
IDPB K, B ;OUTPUT IT
POPJ P, ;EXIT
OCTOUT: SKIPA C, [OCT 10]
NUMOUT: MOVEI C,^D10
NUMO2: IDIVI S, (C) ;RECURSIVE SUBROUTINE
HRLM S+1, (P) ;SAVE REMAINDER ON PUSHDOWN LIST
JUMPE S, .+2 ;IS NUMBER FINISHED?
PUSHJ P, NUMO2 ;NO - LOOP AGAIN
HLRZ K, (P) ;RETRIEVE NUMBER FROM PD LIST
ADDI K, 60 ;MAKE IT ASCII
IDPB K, B ;OUTPUT IT
POPJ P, ;GET NEXT NUMBER OR EXIT
HDRSIX: ILDB K,R ; GET A SIXBIT CHAR
JUMPE K,HDR3 ; DO NOT PRINT NULLS
ADDI K,40 ; MAKE 7-BIT
IDPB K,B ; WRITE INTO BUFFER
HDR3: SOJG S,HDRSIX ; LNOP
POPJ P, ; RETURN
SUBTLE <TELETYPE OUTPUT ROUTINES>
;BASIC TELETYPE OUTPUT ROUTINES
;%MERGE% THESE ROUTINES HAVE BEEN DELETED IN FAVOR OF THE TTCALL
; UUO. ALL ROUTINES FOR BUFFERED TTY I/O HAVE BEEN DELETED.
CMDCHR: TRNN F, CCLBIT!CMDLIN ; CCL FILE OR HAVE CMD LINE?
JRST CMDC1
CMDC0: ILDB A, XB+15(T) ; YES - GET CHARACTER
CAIL A, "A"+40 ; UPPER CASE?
CAILE A, "Z"+40
POPJ P,
SUBI A, 40 ; YES - CONVERT TO UPPER
POPJ P,
CMDC1: MOVE A, PCMDBF ; POINTER TO BUFFER
MOVEM A, XB+15(T)
MOVNI R, ^D128*5-1 ; LENGTH OF BUFFER (IN CHARS)
CMDC2: INCHWL C ; NEXT CHAR
CAIL C, 12
CAILE C, 14 ; BREAK?
CAIN C, 33 ; (ESC)
JRST CMDC3
AOJGE R, ERR12
IDPB C, A
JRST CMDC2 ; AGAIN
CMDC3: IDPB C, A ; PUT BREAK
TRO F, CMDLIN ; GOT IT
JRST CMDC0 ; GIVE FIRST
SUBTLE <READ SOURCE FILES>
;ROUTINE TO INPUT CHARACTERS FROM THE SOURCE DEVICE
;THIS ROUTINE ASSUMES THAT THE COMMAND SCANNER PORTION OF
;THE EXEC HALTS AFTER IT HAS FOUND THE FIRST INPUT FILE.
;ROUTINE CHAR INPUTS CHARACTERS ON CHANNEL 3 UNTIL AN END OF
;FILE CONDITION IS MET. IT THEN CHECKS A FLAG TO SEE IF ANY
;MORE INPUT FILES NEED TO BE INITIALIZED. IF SO, IT RELEASES
;THE OLD INPUT FILE AND INITIALIZES A NEW ONE, AND CONTINUES
;TO DO INPUT ON THIS FILE.
;WHEN THE LAST END OF FILE IS REACHED, THE EXEC PLACES AN
;32 CHARACTER AND A CARRIAGE RETURN IN THE BUFFER
CHARA: MOVEM J,SEQNUM(T)
IFN CMUSW,<
CAMN J,SOSPG ; SKIP IF NOT AN SOS PAGE BREAK
TRO F, FUNNY ;INDICATE DOING SOS PAGE MARK >
MOVNI J,5
ADDM J,2(BU)
AOS 1(BU)
INCHR: SOSG 2(BU)
PUSHJ P,CHAR1
IBP 1(BU)
MOVE J, @1(BU)
TRZE J,1
JRST CHARA
IFN CMUSW,<
TRZE F, FUNNY ;ARE WE DOING SOS PAGE MARK?
JRST INCHR ;YES, SKIP OVER THE 2ND CR >
LDB J,1(BU)
CAIN J,12 ;LINE FEED?
JRST INCHR ;YES - IGNORE
JUMPE J, INCHR
JRST (N) ;NO, RETURN
CHAR1: XCT INLST-3(CH) ;CALL MONITIOR FOR A BUFFER
POPJ P, ;EXIT
HRLZ W,CH ;SET UP
LSH W,5 ; CHANNEL NUMBER
IOR W,[STATO 0,IOEOF]; FOR STATO
XCT W
JRST ERR8 ;INPUT TRANSMISSION ERROR
CAIL CH, REQFST-1 ;ARE WE IN A REQUIRE?
JRST REQEOF ;YES-SPECIAL EOF PROCESSING
PUSHJ P, ACSAVE ;YES, SAVE ACS
HRLI V, T ;PUT T IN INDEX PORTION OF V
CLOSE 3, ; CLOSE THE SOURCE FILE
SETCM W, B20FLG## ; SHOULD WE DELETE SOURCE FILE
TRNN W, 3
PUSHJ P, SRCDEL ; YES - CALL SRCDEL TO DO IT
TRNE F, ENDBIT ;END OF ALL INPUT FILES?
JRST CHAR2 ;YES
MOVE A, XB-1(T) ;PREPARE FOR NEW DEVICE...
EXCH A, XA+F(T) ;...BY RESETTING UPDATED .JBFF
MOVEI D, 3 ;SET CHANNEL NUMBER AC
MOVE A, BLANKS ;STORE BLANKS IN THE SEQ. NO.
MOVEM A, SEQNUM(T) ;...
TRO F, CHRBIT ;SET CHRBIT
MOVEM 0,SAVE0 ; IN CASE WE HAVE TO PUNT
PUSHJ P, GETCH2 ;GET SOME MORE OF THE COMMAND
PUSHJ P, ACREST ;RESTORE THE ACCUMULATORS
POPJ P, ; AND RETURN
CHAR2: MOVEI A, 3 ;SET UP ARTIFICIAL COUNT
MOVEM A, XB+3*3+2(T) ;IN BUFFER HEADER
HRR A, XB-1(T) ;SET UP A BYTE POINTER
HRLI A, 440700 ;...
MOVEM A, XB+3*3+1(T) ;SAVE IT IN THE BUFFER HEADER
MOVEI B, 32 ;EOF CHARACTER (32)
IDPB B, A ;...
MOVEI B, 15 ;CARRIAGE RETURN
IDPB B, A ;...
IFE BLIS11,< TLO F, FINFLG ;GIVE FINAL EOF TO BLISS>
IFN BLIS11,< TRO F, FINFLG ;GIVE FINAL EOF TO BLISS>
PUSHJ P, ACREST ;RESTORE ACS
POPJ P, ; DONE
SRCDEL: SETZM SRCBLK+2 ; NO TIME OR PROTECTION
ENTER 3,SRCBLK ; ENTER SOURCE FILE AGAIN
POPJ P, ; IF FAILURE RETURN
SETZM SRCBLK ; NAME=NULL
RENAME 3,SRCBLK ; DELETE
CLOSE 3, ; IF FAIL RECLOSE THE FILE
POPJ P,
REQEOF: HRLZI W, (RELEAS)
DPB CH, [POINT 4, W, 12] ; PUT CHANNEL NUMBER
XCT W
SOS REQCHN ;REQREL EXPECTS THIS
PUSHJ 0,SVBLIS
PUSHJ 0,REQREL ;CALL COMPILER TO CLEAN UP
PUSHJ 0,SVBLIS
MOVE J,BLANKS
MOVEM J,SEQNUM(T)
MOVEI J,15 ;RETURN A CR
MOVEI $V, 0 ;AND SUCCESS.
HRRM N,0(P) ; 5.200.35 REPLACES JRST (N)
POPJ P, ; 5.200.35 SOLVING THE 22 REQUIRE FILES
;PROBLEM. PAB/25-FEB-76
; INLST IS THE LIST OF IN UUO'S REFERENCED AT CHAR1
INLST: IN 3,
IN 4,
IN 5,
IN 6,
IN 7,
IN 10,
IN 11,
IN 12,
IN 13,
IN 14,
IN 15,
IN 16,
IN 17,
;ROUTINES TO SAVE AND RESTORE THE COMPILER ACCUMULATORS
ACSAVE: EXCH A,0(P) ; A GETS RETURN ADDRESS
PUSH P,B ;
PUSH P,C
PUSH P,D
PUSH P,E
PUSH P,G
PUSH P,H
PUSH P,R
PUSH P,S
PUSH P,V
PUSH P,S+1
JRST @A ; SNEAKY
ACREST: POP P,A ; A_RETURN ADDRESS
POP P,S+1
POP P,V
POP P,S
POP P,R
POP P,H
POP P,G
POP P,E
POP P,D
POP P,C
POP P,B
EXCH A,0(P) ; TOP_RETURN; A_PREVIOUS TOP
POPJ P, ; SNEAKY (SEE COMMENT ABOVE)
OUTBN2:
IFN BLIS11,< POPJ P, ;IGNORE OUTPUT TO BIN FILE; AT LEAST FOR NOW>
OUTPUT 1, ;OUTPUT ON CHANNEL 1
STATZ 1, IODATA+IOBKTL+IODEV ;CHECK FOR ERRORS
JRST ERR10 ;TRANSMISSION ERROR
POPJ P, ;RETURN
SUBTLE <ERROR ROUTINES>
;ERROR ROUTINES
;BAD CHARACTER OR NUMBER IN SWITCH MODE
ERR1: OUTSTR QUESER ; PUT QUESTION MARK
MOVEI G,55 ;PUT - CHARACTER INTO SCRACTH REG 2/16/78
TRZE F,UNBIT ;CLEAR COMPLEMENT BIT 2/16/78
OUTCHR G ; 2/16/78
OUTCHR K
OUTSTR ERR1M ;TYPE A MESSAGE
JRST ERROR ;DONE
;BAD CHARACTER IN COMMAND STRING, NORMAL MODE
ERR2: OUTSTR QUESER
OUTCHR K ;TYPE THE BAD CHARACTER
OUTSTR ERR2M ;MESSAGE
JRST ERROR
;XXX IS NOT AVAILABLE
ERR3: OUTSTR QUESER
PUSHJ P, STYPO ;TYPE THE DEVICE NAME
OUTSTR ERR3M ;GET A MESSAGE
ERR3A: CAIN D, 3 ;SOURCE DEVICE?
POP P, A ;YES, CLEAR JUNK OFF PD LIST
JRST ERROR
; BLISS COMMAND ERROR
ERR4: OUTSTR ERR4M ;TYPE A MESSAGE
JRST ERROR
;LOOKUP FAILURE
ERR5: CAIE D, 3 ;LOOKUP ERROR?
JRST ERR5B ;NO, ENTER ERROR
TRNE F, EXTBIT ; EXPLICIT EXTENSION?
JRST ERR5B
HLRZ A, XE+4(T) ;GET FILE NAME EXTENSION
JUMPE A, ERR5B ;IS IT BLANK?
MOVEI S, 0 ;NO, TRY ANOTHER LOOKUP
CAIN A, (SIXBIT /BLI/) ; FIRST DEFAULT?
MOVSI S, (SIXBIT /B10/) ; YES - TRY NEXT
JRST LOOK3 ;ENTER LOOKUP ROUTINE AGAIN
;ENTER FAILURE OR 2ND LOOKUP FAILURE
ERR5B: LDB S,[POINT 2,XE+4(T),35]
HRRZ L, ERR5TB(S) ;LOAD LOOKUP ERROR MSG POINTER
CAIE D, 3 ;WAS IT REALLY A LOOKUP ERROR?
HLRZ L, ERR5TB(S) ;NO, SO LOAD ENTER ERROR MSG POINTER
OUTSTR (L) ; TYPE IT
MOVE S, XE+3(T) ;GET THE FILE NAME
PUSHJ P, STYPO ;TYPE IT
MOVEI A,"."
OUTCHR A
HLLZ S,XE+4(T) ; GET THE EXTENSION
PUSHJ P,STYPO ; TYPE IT TOO
SKIPE A,PPNVAL ; TEMPORARY PPN?
JRST PPPN ; YES---OUTPUT IT
SKIPN A,PPNPERM ; PERMANENT PPN?
JRST NOPPPN ; NO---NONE AT ALL
PPPN: PUSH P,A ; SAVE PPN
MOVEI A,"["
OUTCHR A
POP P,A ; RESTOR A
HRRI S,PPNBUFF ; POINT TO BUFFER
IFN CMUSW,<
HRLI S,A ; AND A
CALL S,[SIXBIT /DECCMU/] ; AND CONVERT IT
JRST PPNX ; SOMETHING HAPPENED>
IFE CMUSW,<
HRLI S,440700
PUSH P,S+1 ; SAVE S+1
PUSH P,S+2
PPNA4: MOVEI S+2,6
PPNA3: LDB S+1,[POINT 3,A,2]
JUMPN S+1,PPNA1 ; IF NOT 0, GO PRINT IT
PPNA2: LSH A,3 ; SHIFT OVER PPN
SOJG S+2,PPNA3 ; GET NEXT
JUMPE A,PPNA6 ; ARE WE DONE?
MOVEI S+1,"," ; PRINT ,
IDPB S+1,S
JRST PPNA4 ; GET PROGRAMMER NO.
PPNA1: ADDI S+1,"0" ; CONVERT TO ASCII
IDPB S+1,S ; PLUNK IT DOWN
JRST PPNA2 ; AND GET NEXT DIGIT
PPNA6: SETZ S+1,
IDPB S+1,S ; AMKE IT ASCIZ STRING
POP P,S+2
POP P,S+1 >
OUTSTR PPNBUFF ; PRINT PPN
MOVEI A, "]"
OUTCHR A
NOPPPN: OUTSTR ERR5MA ;"ON DEVICE "
MOVE S, XE+1(T) ;GET DEVICE NAME
PUSHJ P, STYPO ;TYPE IT
OUTSTR [BYTE(7)15,12]
JRST ERROR ;EXIT
;OUTPUT ERROR ON LISTING DEVICE
ERR7: MOVEI D, 2 ;LISTING IS DEVICE NUMBER 2
JRST ERR10A ;ENTER COMMON ROUTINE
;INPUT ERROR ON SOURCE DEVICE
ERR8: MOVEI D, 3 ;SOURCE IS DEVICE NUMBER 3
JRST ERR10A ;ENTER COMMON ROUTINE
;OUTPUT ERROR ON BINARY DEVICE
ERR10: MOVEI D, 1 ;BINARY IS DEVICE NUMBER 1
ERR10A: OUTSTR ERR10C ;"TRANSMISSION ERROR ON "
OUTSTR @ERR10M-1(D) ;GET DEVICE TYPE
TRO F,CHRBIT ; TRICK IT INTO PUNTING
MOVEM 0,SAVE0 ; PUNT GLITCH NEEDS THIS TOO
JRST ERROR
;XXX IS NOT A DEVICE
ERR11: OUTSTR QUESER
MOVE S, XE+1(T) ;GET DEVICE NAME
PUSHJ P, STYPO ;TYPE IT
OUTSTR ERR11M ;"IS NOT A DEVICE"
JRST ERROR
;INPUT LINE TOO LONG
ERR12: OUTSTR ERR12M ;SEND THE MESSAGE
JRST ERROR
;XXX CANNOT DO IO AS REQUESTED
ERR15: OUTSTR QUESER
PUSHJ P, STYPO ;TYPE DEVICE NAME
OUTSTR ERR15M ;GIVE A MESSAGE
JRST ERR3A ;ENTER "NOT AVAILABLE" ROUTINE
;XXX CANNOT BE USED AS AN XXX DEVICE
ERR17: OUTSTR QUESER
PUSHJ P, STYPO ;TYPE DEVICE NAME
OUTSTR ERR17M ;GIVE A MESSAGE
OUTSTR @ERR10M-1(D) ;GIVE DEVICE TYPE
JRST ERROR
ERR18: OUTSTR ERR18M ;
JRST ERROR
PPNERR: OUTSTR ERRPPN ; PPN ERR
MOVEI A, "["
OUTCHR A
OUTSTR PPNBUF
MOVEI A, "]"
OUTCHR A
OUTSTR [BYTE(7)15,12]
JRST ERROR
ERRPPN: ASCIZ "? ILLEGAL PPN: "
IFN BLIS11,<
INTERNAL BLEXIT
BLEXIT: CLOSE 1,
CLOSE 2,
CLOSE 4,
CLOSE 5,
EXIT >
;AUXILIARY ERROR SUBROUTINES
ERROR: TRNE F,CCLBIT ; ARE WE IN CCL MODE?
PUSHJ P,CCLPRT ; GIVE USER A CLUE
TRZE F,CHRBIT ; DID WE COME FROM CHR ROUTINE?
JRST PUNTIT ; YES...PUNT
SETZM CCLCTL ; CLEAR CCL SWITCHES
JRST F4EXEC
PUNTIT: MOVE 0,SAVE0 ; GET BLISS STACK REG
SETZM CCLCTL
PUSHJ 0,SVBLIS ; BACK TO BLISS WORLD
PUSH 0,[500] ; PUNT (#500);
PUSHJ 0,PUNT
; OUTPUT UP TO ERROR THE CCL STRING
CCLPRT: MOVE B,CCLBP ; GET CURRENT BYTE POINTER
HRRZI A,CCLBUF ; BUFFER
HRLI A,440700 ; POINTER
MOVEM A,CCLBP ; RESET TO BEGINNING
PLOP: ILDB A,CCLBP ; GET A CHAR
JUMPE A,PLEND ; QUIT IF NULL
OUTCHR A
CAME B,CCLBP ; AT ERROR YET?
JRST PLOP ; NO---KEEP PRINTING
PLEND: OUTSTR [BYTE(7)15,12]
POPJ P,
;ROUTINE STYPO TYPES THE SIXBIT NAME IN AC S.
STYPO: MOVEI B, 6 ;SIX CHARACTERS
MOVE C, SYMPTR ;POINTER TO AC A
STYPO2: ILDB A, C ;GET A CHARACTER
JUMPE A, STYPO3 ;DONT TYPE A NULL
ADDI A, 40 ;CONVERT TO SEVEN BIT ASCII
OUTCHR A
STYPO3: SOJG B, STYPO2 ;MORE TO TYPE?
POPJ P, ;NO, EXIT
SUBTLE <ERROR MESSAGES>
;ERROR MESSAGE ADDRESSES
ERR10M: XWD 0, ERR10D
XWD 0, ERR10E
XWD 0, ERR10F
ERR5TB: XWD ERR6M,ERR5M
XWD ERR16M,ERR16M
XWD ERR14M,ERR14M
XWD ERR13M,ERR13M
;ERROR MESSAGES
QUESER: ASCIZ "? "
ERR1M: ASCIZ " is an illegal switch
"
ERR2M: ASCIZ " is an illegal character
"
ERR3M: ASCIZ " is not available
"
ERR4M: ASCIZ "? Command error
"
ERR5M: ASCIZ "? Cannot find file "
ERR5MA: ASCIZ " on device "
ERR6M: ASCIZ "? Invalid file name: "
ERR10C: ASCIZ "? Transmission error on "
ERR10D: ASCIZ "binary device
"
ERR10E: ASCIZ "listing device
"
ERR10F: ASCIZ "source device
"
ERR11M: ASCIZ " is not a device
"
ERR12M: ASCIZ "? Input line too long
"
ERR13M: ASCIZ "? File being modified: "
ERR14M: ASCIZ "? Directory full or file write-protected: "
ERR15M: ASCIZ " cannot do IO as requested
"
ERR16M: ASCIZ "? Non-existant UFD: "
ERR17M: ASCIZ " cannot be used as "
ERR18M: ASCIZ "? Double period in filename"
IFN BLIS11,<
IFN CMUSW,<
EXPMES: ASCIZ "EXPERIMENTAL BLIS11. MAIL ERRORS TO N110JZ07.
">
IFE CMUSW,<
EXPMES: ASCIZ "EXPERIMENTAL BLIS11. REPORT ALL ERRORS TO BLIS11 GROUP
">>
SUBTLE <BLISS INTERFACE ROUTINES>
; BLISS INTERFACE ROUTINES
;---------------------------
DEFINE RENTRY <
IFE TIMSW,<>
IFN TIMSW,<
HRRZI 12,0
PUSH 12
PUSHJ TIMER
SUB 0,[XWD 1,1]
>>
DEFINE REXIT <
IFE TIMSW,<>
IFN TIMSW,<
HRROI 12,0
PUSH 12
PUSHJ TIMER
SUB 0,[XWD 1,1]
>>
SVBLIS: EXCH B,BXA+B
EXCH F,BXA+F
EXCH T,BXA+T
EXCH P,BXA+P
EXCH J,BXA+J
EXCH K,BXA+K
EXCH L,BXA+L
EXCH N,BXA+N
POPJ 0,0
FORCE: RENTRY
PUSHJ 0,SVBLIS
MOVE K,0
MOVE K,-1(K)
XCT DSLIST(K)
PUSHJ 0,SVBLIS
REXIT
POPJ 0,0
DSLIST: JFCL
PUSHJ P,OUTBN2
PUSHJ P,LIST1
JFCL
JFCL
INITIO: RENTRY
PUSHJ 0,SVBLIS
EXCH 0,BXA
JSP N,RENBIO ;NEW NAME FOR REENTRANT CODE
MOVEI N,XB(T)
MOVEM N,DEVBPT
EXCH 0,BXA
PUSHJ 0,SVBLIS
REXIT
POPJ 0,0
FINIO: RENTRY
SKIPE 0,ERRORFOUND ; DON'T CLOSE REL CHANNEL IF THERE WERE ERRORS
JRST FINIOA
CLOSE 1,0
SKIPE SAVBLK ; DON'T RENAME IF NO BINARY FILE
PUSHJ 0,RENAM
FINIOA: CLOSE 2,0
RESET
TLO F, BINFLG!LSTFLG!CANLST ; %2.19% DEVICES HAVE BEEN RELEASED
REXIT
POPJ 0,0
; DELETE THE FOLLOWING SIX LINES. THE DEC10 AND DEC20 COMPATABILITY
; PROBLEM. ON DEC10, RENAME FILLS UP CREATION DATE/TIME.
; ON DEC10, RENAME FILLS UP DATE/TIME EVEN COMPILER FILLS IT.
; ON DEC20, RENAME FILLS UP CREATION DATE/TIME. ON DEC20,
; IF COMPILER FILLS UP , THEN RENAME FILLS UP WITH WRONG DATE/TIME.
; RENAME ON DEC20 GETS CONFUSED. JAN-18-78
; RENAM: TIMER 4, ; TIME
; IDIVI 4,7020 ; IN MINUTES
; DATE 5,
; LSH 4,14
; IOR 4,5
; DPB 4,[POINT 23,SAVBLK+2,35]
RENAM: HLLZ 4,SAVBLK+1 ; GET THE FILE EXTENSION
MOVEM 4,SAVBLK+1 ; ZERO OUT THE RIGHT HALF
SETZM SAVBLK+2 ; ZERO OUT DATE/TIME
MOVE 4,SAVBLK+3
MOVEM 4,SAVBLK-1
MOVEI 4,4
MOVEM 4,SAVBLK-2 ; EXTENDED RENAME
RENAME 1,SAVBLK-2
JFCL
POPJ 0,
IFE BLIS11,<
PAGER: RENTRY
PUSHJ 0,SVBLIS
SETZM RPAGE ; CLEAR RPAGE FLAG
AOS SOSPGC ; INCREMENT PAGE COUNT
SETOM PAGCNT(T) ; RESET SUPPLEMENTAL PAGE COUNT
JRST PAGE1 ; SNEAKY EXIT THROUGH 'PAGE'
>
PAGE: RENTRY
PUSHJ 0,SVBLIS
PAGE1: TLNN F,LSTFLG
JSP N,HEDR
PUSHJ 0,SVBLIS
REXIT
POPJ 0,0
TTYLIS: RENTRY
PUSHJ 0,SVBLIS
MOVE K,0
MOVE K,-1(K)
OUTCHR K
PUSHJ 0,SVBLIS
REXIT
POPJ 0,0
READTEXT: RENTRY
PUSHJ 0,SVBLIS
MOVEI $V, 0 ; BE READY TO SUCCEED
MOVE N, [POINT 7,BUFF]
MOVEM N,PBUFF
SETZM DLCNT##
MOVEI N, BUFFL
MOVEM N, RDCNT
MOVEI J, " "
JSP N, PACK
IFE BLIS11,< TLNE F, FINFLG >
IFN BLIS11,< TRNE F, FINFLG >
JRST RTEXIT
MOVE CH,REQCHN
CAIL CH, REQFST ;LOWEST REQUIRE CHAN
JRST [HLRZ BU,REQDATA(CH)
JRST RTEXT1]
MOVEI CH,3
MOVEI BU,XB+11(T)
RTEXT1: JSP N,INCHR
JSP N,RTEXT3
RTEXT2: SOSG 2(BU)
PUSHJ P,CHAR1 ;GET A NEW BUFFER
ILDB J,1(BU)
RTEXT3: CAIGE J," "
JRST LOCHAR ;CONTROL CHARACTER
CAIN J,177 ; RUBOUT?
JRST DLCHAR
PACK: SOSGE RDCNT
JRST RTEXT5 ;LINE TOO LONG
IDPB J,PBUFF
JRST (N) ;LOOP
DLCHAR: AOS DLCNT## ; INCRIMENT DELETE CHARACTER COUNT
JRST RTEXT2 ; OTHERWISE IGNORE IT.
LOCHAR: CAIN J,11 ;TAB
JRST PACK
CAIN J,15 ;CR
JRST RTEXT4
CAIE J,14 ; FF?
JRST RTEXT2 ; NO - IGNORE
TLNE F, LSTFLG ; LISTING?
JRST RTEXT1 ; NOT LISTING - DON'T MODIFY PAGE FLAGS
IFN BLIS11,<AOS SOSPGC ;YES, INCREMENT PAGE COUNT
SETOM PAGCNT(T) ;RESET ACTUAL PAGE PER LOGICAL PAGE COUNT
SETOM DOPAGE > ;INDICATE FORM FEED WAS SEEN
IFE BLIS11,<SETOM RPAGE ; SPECIAL FF FLAG FOR BLIS10
JRST RTEXT1 ; AND PASS IT BY>
RTEXT4:
IFE BLIS11,< JSP N, PACK>
RTEXIT: MOVEI J,177
JSP N, PACK
IFN BLIS11, <
MOVEI J, 15
JSP N, PACK >
RTEX1: MOVE N, [POINT 7,BUFF]
MOVEM N,PBUFF
PUSHJ 0,SVBLIS
REXIT
POPJ 0,0
RTEXT5: JSP N, INCHR
CAIE J, 15 ; FIND NEXT <RET>
JRST RTEXT5
MOVEI $V, 1 ; ERROR ON LINE
MOVEI J, 177
DPB J, PBUFF ; STASH #177
JRST RTEX1
SUBTLE <CONSTANT DATA AREA>
PGEMES: ASCII "Page "
IFE BLIS11,<
NAME1: ASCII /;BLIS/
NAME2: ASCII /S-10 / >
IFN BLIS11,<
NAME1: ASCII /; BLI/
NAME2: ASCII /S11 V/ >
BLANKS: BYTE(7)40,40,40,40,40
CHPTR: POINT 4, A, 12
SYMPTR: POINT 6, S
PCMDBF: POINT 7, CCLBUF ; POINTER TO BUFFER AREA FOR TTY CMD STRING
; AND CCL STR TOO
TTPNT2: POINT 7, TTLBUF(T)
TTLPNT: POINT 7, TTLBUF+2(T)
PGEPTR: POINT 7, PGEMES
MAJVBP:: POINT 9, .JBVER, 11 ; MAJOR VERSION NUMBER
MINVBP:: POINT 6, .JBVER, 17 ; MINOR VERSION NUMBER
WHOBP: POINT 3, .JBVER, 2 ; LAST EDITOR
IFE BLIS11,<
BUFFL==^D29*5> ;LENGTH OF SOURCE LINE BUFFER
IFE NONREN, <XLIST ; LITERALS IN HISEG
LIT
LIST>
SUBTLE <IMPURE SEGMENT>
IFE NONREN,<RELOC> ;LOW SEG
BIO: BLOCK 1 ;ZERO IF INITIO HAS NEVER BEEN CALLED
; CONTROL WORDS FOR CCL CAPABILITIES
CCLCTL: BLOCK 1 ; CCL SWITCHES
; 1=> CCL ENTRY, 3=> CCL FILE READ
; 0 => NO CCL ENTRY
CCLBP: BLOCK 1 ; BYTE POINTER FOR CCL FILE
CCLBUF: BLOCK ^D128 ; BUFFER FOR CCL COMMANDS
SAVE0: BLOCK 1
RDCNT: BLOCK 1
SOSPGC:: BLOCK 1
SAVP: BLOCK 1 ; PLACE TO SAVE PACCUM
BINFIL: BLOCK 1 ; ACCUMULATE MODULE NAME SWITCH
PPNBUF: BLOCK 3 ; WHERE WE HOLD PPN'S
PPNVAL: BLOCK 1 ; WHAT OUR PPN IS
PPNPER: BLOCK 1 ; A PERMANENT PPN
TTOBUF: BLOCK 1
IFN DETSW,<
SAVEK: BLOCK 1 ;SAVE REG FOR DETACH CHECK>
QSAVBLK: BLOCK 6 ;SAVE ENTER BLOCK FOR RENAME OF BINARY FILE
SAVBLK=QSAVBLK+2
QSRCBLK: BLOCK 6 ;SAVE LOOKUP BLOCK FOR DELETION OF SOURCE FILE
SRCBLK=QSRCBLK+2
IFE BLIS11,<RPAGE: BLOCK 1> ;FOR ROUTINE PAGE FLAG
END