Trailing-Edge
-
PDP-10 Archives
-
decuslib10-05
-
43,50337/14/e3.mac
There are 2 other files named e3.mac in the archive. Click here to see a list.
;<TENDERIN>E3.MAC.7, 16-Jan-77 23:53:20, Edit by ENDERIN
SUBTTL E3
;AUTHORS: KIM WALDEN
; .
; ELISABETH ALUND
;VERSION: 4 [4,5,7,45,104,144,170,217,225,275]
;PURPOSE: Create LST file and type error messages on the user's terminal
;CONTENTS:
;LOCAL SUBROUTINES: E3BD Convert binary to ASCII decimal
; E3BE Create BEGIN END numbers
; E3DM Sort DM
; E3EM Create error messages
; E3LI Interpret control word
; E3IN
; E3PAGE Create page heading
;EXTERNAL SUBROUTINES: See below
SALL
SEARCH SIMMAC
CTITLE E3
edit(104)
SEARCH SIMMC3 ;[104]
TWOSEG
RELOC 400000
MACINIT
P3INIT ;[104]
LS1INIT
;EXTERNAL SUBROUTINES
EXTERN I3S ;Routine to open source code file
EXTERN T3E ;Error statistics
EXTERN T3L ;Close files
EXTERN I3LS3 ;Open LS3
EXTERN I3L ;Routine to open LS1
EXTERN O3ERR ;Routine to read error handling tables into core
EXTERN O3RS ;Read LS1.TMP
EXTERN O3WS ;Write LS3.TMP
EXTERN O3RSC ;Read infile.SIM
EXTERN O3SCLS ;Read last part of source and output to list
;with no editing of line numbers etc
EXTERN SIMXRF ;Cross reference list
EXTERN ZLEREC ;Word to keep record from LS1
;[104] EXTERN ZDM ;Diagnostics buffer
EXTERN ZSE ;Symbol table
EXTERN YBHSRC ;Buffer header for source code
EXTERN YBHLS3 ;Buffer header LS3
EXTERN Y3LINH ;Buffer header preceding line
EXTERN YELSRC ;LOOKUP arg for source code
EXTERN Y3DEV ;Device of source
EXTERN YE3PGH ;Page header line 1
EXTERN YE3PNN ;Number of characters in last part of header
EXTERN YE3PNM ;Page header line 2
EXTERN Y3BUF ;Buffer
EXTERN YE3LIN ;Line buffer
EXTERN YE3LIP ;Byte pointer to YE3LIN
EXTERN YE3RUB ;Page heading
EXTERN YE3NRU ;Number of bytes in heading
EXTERN YE3ERR ;Buffer for errormessages
EXTERN YE3END ;Number of last end on current line
EXTERN YE3BEG ;Number of BEGIN's generated
EXTERN YBEGSP ;Stack pointer to BEGIN stack
EXTERN YBEGNO ;Number of BEGINs in source prog
EXTERN YE3PAG ;Number of lines per pages
EXTERN YE3PGN ;Current page number
EXTERN YE3PNO ;Number of lines on current page
EXTERN YE3LNO ;Current linenumber
EXTERN YE3LS3 ;Number of bytes to output to LS3.TMP
EXTERN YE3D ;Table for error handling
EXTERN YE3M
EXTERN YE3MI
EXTERN YE3DL
EXTERN YSWITCH ;Switch word
EXTERN Y3PLTE ;Pointer to end of line number table
EXTERN Y3PLTS ;Pointer to start of line number table
EXTERN Y3OPEN ;Word containing switches
EXTERN YDMPT3 ;for error handling
EXTERN YSIXB
EXTERN YDMEND ;Length of utilized part of DM
EXTERN YDMB2
EXTERN YZDM ;Buffer used when sorting ZDM
EXTERN YZDMI ;Buffer used when sorting ZDM
EXTERN YERRCT ;Number of errors encountered
EXTERN YWARCT ;Number of warnings encountered
EXTERN .JBVER
edit(144)
EXTERN Y3SFD ;[144] Space for SFD path record
EXTERN YRLSFD ;[144] SFD path for REL file
EXTERN YLSSFD ;[144] SFD path for LST file
;ROUTINES CALLED FROM OTHER MODULES
INTERN E3LICF ;Update page number at form feed or VT
INTERN E3BD ;Converts to decimal ASCII
INTERN E3DB ;Convert from decimal ASCII to binary
INTERN E3EM ;Entry for routine creating errormessages
INTERN E3 ;Main entry point
;Macro to generate table containing symbols defined in the SYMB macro
;(SIMMAC). The symbols are sorted in numeric order
;and are generated in SIXBIT. The table is used for error handling.
ERR1==0
DEFINE ERRSY(A,B,C,D)<
REPEAT B-ERR1,<0
0>
ERR1==B+1
IFB <D>,<0
0>
IFNB <D>,<SIXBIT ?D?
ERR2==6
IRPC D,<ERR2==ERR2-1>
IFGE ERR2,<0>
>
>
edit(225)
TOPS20,<OPDEF OUTINT [NOUT]>
TOPS10,<OPDEF OUTINT [XEC E3PNOU]>
IF1,<;[225]
QDIRTR==0 ;Determines if [p,pn] - <directory> transl done
IFN QDEC20,<IFDEF PPNST,<QDIRTR==1>>
>
edit(217)
DEFINE $HDVER(A)<POINT 7,A+4,35> ;;[217] Pointer to version field
DEFINE $HD10(A) <POINT 7,A+2,27> ;;[217] DPB pointer to "10"
DEFINE VERLST <;;[217]
BYTE (7)QFF,QCR,QLF,"D","E"
ASCII/Csystem-10 SIMULA %# />
COMMENT /EXAMPLE %3AM(777)-5
VMM E W
VERLST is used to produce headings of
SIMULA source code and cross-reference lists.
/
E3:
PROC
SETZB XDM1,YE3LNO
LI XDM2,1
SETZM YE3BEG
SETZM YE3NRU
edit(7)
SETZM YE3PGN ;[7] START WITH 0 IN YE3PGN AND LET
; E3LICS UPDATE MAIN PAGE NUMBER
SETZM YE3PNO
SETZM YE3END
LI X0,QPAGE
ST X0,YE3PAG
IF
SKIPN YDMEND
GOTO FALSE
THEN
;ERRORS
EXEC O3ERR ;READ ERROR TABLES INTO CORE IF ERRORS IN PROG
EXEC E3DM ;SORT ERROR MESSAGES IN LINENUMBER ORDER
SETOM ZDM-2
L X1,YDMEND
SETOM ZDM+1(X1)
FI
EXEC I3L ;OPEN LS1
L X0,[POINT 7,YE3LIN] ;INIT BYTE POINTER
ST X0,YE3LIP
SETZM YE3LS3
LOOP
EXEC O3RS ;READ WORD FROM LS1
SKIPA ;CORRECT RETURN
AS GOTO FALSE ;RETURN AT END OF FILE
IF TRNE X1,1 ;CHECK IF CONTROL WORD
GOTO FALSE
THEN ;NOT A CONTROL WORD
SKIPGE X2,YE3NRU
SETZB X2,YE3NRU ;RESET COUNTER FIRST TEXT WORD
ST X1,YE3RUB(X2) ;STORE WORD IN PAGE HEADER
AOS YE3NRU ;COUNT OF NUMBER OF WORDS IN HEADER
ELSE
HLRZ X0,X1
LSH X0,-^D11
IF CAIE X0,"I"
GOTO FALSE
THEN EXEC E3IN ;LINE IDENTIFICATION WORD
ELSE
IF CAIE X0,"B"
CAIN X0,"E"
GOTO FALSE
THEN EXEC E3LI ;INTERPRET CONTROL WORD
ELSE
EXEC E3BE ;GENERATE BEGIN END STRUCT
FI
FI
FI
GOTO TRUE
SA ;END OF FILE
;OUTPUT ERRORS WITH TOO HIGH LINE NUMBER
WHILE
CAML XDM2,YDMEND
GOTO FALSE
DO
EXEC E3ERRE
OD
;OUTPUT REMAINING CHARACTERS IN SOURCE (IF ANY)
IFONA YE3LST
EXEC O3SCLS
LI X0,1
SKIPE YWARCT ;COUNT NUMBER OF LINES TO OUTPUT
ADDI X0,1
SKIPE YERRCT
ADDI X0,1
CAML X0,YE3PNO
EXEC E3P2 ;OUTPUT NEW PAGE
EXEC T3E ;CREATE STATISTICAL INFORMATION OF ERRORS
IF ;List wanted
IFOFFA YE3LST
GOTO FALSE
THEN
IF ;Line number table wanted (/Y)
IFOFF YSWY
GOTO FALSE
THEN ;Make table if REL file is created
IFOFFA NOREL
EXEC E3LT
FI
IFON Y3SWC ;CHECK IF CROSS REF LIST WANTED
EXEC SIMXRF
LI X1,E3CR ;OUTPUT CR LF AT END OF LIST FILE
EXEC O3WS,[<2>]
FI
EXEC T3L ;RENAME LS3 DELETE LS1 CLOSE SOURCE CODE FILE
RETURN
EPROC
SUBTTL E3BD
;PURPOSE: CONVERT WORD IN BIN FORMAT TO ASCII DEC WITH LEADING SPACE
;ENTRY: E3BD
;INPUT ARGUMENT: REG X0 CONTAINING WORD IN BIN FORMAT <= DEC 99999
;NORMAL EXIT: RETURN
;ERROR EXIT: -
;OUTPUT ARGUMENTS: REG X1 CONTAINING NUMBER IN DEC ASCII FORMAT
; LEFT JUSTIFIED AND PRECEDED BY BLANKS
;CALL FORMAT: EXEC E3BD
E3BD: SAVE <X2,X3>
SETZB X2,X3
LOOP IDIVI X0,^D10
ADDI X1,60 ;CONVERT REMAINDER TO ASCII
LSHC X1,-7 ;SAVE DIGITS IN X2
ADDI X3,7
AS
JUMPN X0,TRUE
SA
LSHC X1,1(X3)
IOR X1,[ASCIZ/ /]
RETURN
SUBTTL E3DB
;PURPOSE: CONVERT WORD IN DEC ASCII FORMAT TO BIN
;ENTRY: E3DB
;INPUT ARGUMENT: REG X0 CONTAINING WORD TO CONVERT,
; TEXT LEFTJUSTIFIED BUT MAY BE PRECEDED BY ZEROES
;NORMAL EXIT: RETURN
;ERROR EXIT: -
;OUTPUT ARGUMENT: BINARY NUMBER IN X1
;CALL FORMAT: EXEC E3DB
E3DB: SAVE <X2>
L X1,X0
IF ;NON-ZERO
JUMPE X1,FALSE
THEN
TRZ X1,1
SETZB X2,X0
LOOP
LSHC X0,7
AS
JUMPE X0,TRUE
SA
LOOP
IF
CAIGE X0,"0"
GOTO TRUE
CAIG X0,"9"
GOTO FALSE
THEN
;NO DEC DIGIT
LI X0,"0"
IFN QDEBUG,<SKPINC
NOP
OUTSTR [ASCIZ /
NOT AN ASCII CHARACTER TO CONVERT PASS 3
/]>
FI
SUBI X0,"0"
ADDM X0,X2
AS
JUMPE X1,FALSE
IMULI X2,^D10
LI X0,0
LSHC X0,7
GOTO TRUE
SA L X1,X2
FI
RETURN
SUBTTL E3BE
;PURPOSE: GENERATE BEGIN OR END NUMBER
;ENTRY: E3BE
;ERROR EXIT: I3OF IF STACK OVERFLOWS
;NORMAL EXIT: RETURN
;INPUT ARGUMENT:
; REG X0 CONTAINING ASCII "B" OR "E"
; YE3BEG NUMBER OF BEGINS GENERATED
; YE3END NUMBER OF END ON CURRENT LINE
; YBEGST BEGIN STACK
; YBEGSP STACK POINTER
;OUTPUT ARGUMENTS: BEGIN/END FOLLOWED BY NUMBER IN YE3LIN
; YE3LIP BYTE POINTER YE3LIN
; IF THERE ARE SEVERAL BEGINS AND/OR ENDS ON A LINE
; ONLY THE FIRST NUMBER OF BEGIN AND/OR LAST END IS PRINTED
;CALL FORMAT: EXEC E3BE
E3BE::
PROC
SAVE <X2,X6>
L X6,X0
L X2,YBEGSP ;STACK POINTER BEGIN STACK
IF CAIE X6,"B"
GOTO FALSE
THEN
;UPDATE BEGIN NUMBER FOR EACH BEGIN ON LINE AND STORE IN STACK
;MORE THAN 64 BEGINS AFTER EACH OTHER WITH NO END IN BETWEEN
;CAUSE TERMAINATION ERROR,STACK OVERFLOW
;ONLY THE NUMBER OF THE FIRST BEGIN IS PRINTED IN THE SOURCE LIST
AOS YE3BEG
PUSH X2,YE3BEG
L X0,YE3BEG
;OUTPUT FIRST BEGIN NUMBER ON LINE
SKIPN YE3LS3
EXEC E3BEL
ELSE
;UPDATE END NUMBER
POP X2,YE3END
;RETURN AT ONCE IF TOO MANY END
SKIPGE YE3END
AOBJN X2,E3BE2
FI
E3BE2:
ST X2,YBEGSP
RETURN
EPROC
E3BEL:
;OUTPUT BEGIN/END NUMBER
;INPUT X6=ASCII B OR E,
; X0=CURRENT NUMBER BIN
IDPB X6,YE3LIP
AOS YE3LS3
EXEC E3BD
LI X6,5
LOOP
LSHC X0,7
AS
TRNN X0,137
SOJA X6,TRUE
SA
ADDM X6,YE3LS3
LOOP
IDPB X0,YE3LIP
LSHC X0,7
AS
SOJG X6,TRUE
SA
RETURN
SUBTTL E3DM
;PURPOSE: SORT ZDM IN LINE NUMBER ORDER
;ENTRY: E3DM
;INPUT ARGUMENT: ZDM
; YDMEND INDEX OF FIRST FREE PLACE IN ZDM
;NORMAL EXIT: RETURN
;ERROR EXIT:
;OUTPUT ARGUMENTS: ZDM
;CALL FORMAT: EXEC E3DM
E3DM::
PROC
SAVE <X2,X3,X4,X5,X6,X7,X10>
SETZB X2,X4
L X0,YDMEND ;INIT INDEXES
CAIGE X0,3
GOTO E3DME ;NO SORTING IF ONE OR NO ELEMENT
;SAVE IN YZDM ALL INDEXES OF ELEMENTS IN ZDM WITH FIRST LINENUMBER
;<= FIRST LINE NUMBER OF PRECEDING ELEMENT, THUS THERE WILL
;BE GROUPS WITH ELEMENTS IN INCREASING LINE NUMBER ORDER
WHILE
HRRZ X0,ZDM(X2)
ADDI X2,3
CAML X2,YDMEND
GOTO FALSE
DO
HRRZ X1,ZDM(X2)
IF
CAMGE X0,X1
GOTO FALSE
THEN
ST X2,YZDM(X4)
ADDI X4,1
SETZM YZDM(X4)
FI
OD
JUMPE X4,E3DME
SETOFA YE3DM ;INDICATE NO GROUPS SORTED
SETZB X2,X4
SETZB X5,X6
SETZM YZDMI
E3DM1:
L X2,YZDMI(X4)
SKIPN X3,YZDM(X6) ;GET START INDEXES OF THE TWO
;GROUPS TO SORT NOW
GOTO E3DM6 ;NO MORE GROUPS TO SORT
MOVN X7,X3 ;NUMBER OF ELEMENTS IN FIRST GROUP
IDIVI X7,3
HRL X4,X7
ADDI X6,1
SKIPN X7,YZDM(X6)
L X7,YDMEND
ST X7,YDMB2
MOVN X7,X7
IDIVI X7,3
HRL X5,X7
HRRZ X0,ZDM(X2)
HRRZ X1,ZDM(X3)
;Sort two groups in increasing line number order
;i.e. save in YZDMI indexes of the elements in ZDM
;Place index of element with lowest line number first etc.
E3DM5:
CAML X0,X1
GOTO E3DM7
E3DM2:
;ELEMENT IN FIRST GROUP LESS THAN EL IN SECOND GROUP
ST X2,YZDMI(X5)
IF
AOBJN X4,FALSE
THEN
;NO MORE ELEMENTS IN THE FIRST GROUP
IF
IFONA YE3DM
GOTO FALSE
THEN
LI X4,0
SETONA YE3DM
ELSE
CAIN X4,QLDM/3
LI X4,0
FI
LI X0,-1
ELSE
;MORE ELEMENTS IN FIRST GROUP
IF
IFOFFA YE3DM
GOTO FALSE
THEN ;ALL TIMES EXCEPT FIRST:
HRRZ X2,X4
CAIL X2,QLDM/3
HRRI X4,0
L X2,YZDMI(X4)
ELSE
ADDI X2,3
FI
HRRZ X0,ZDM(X2)
FI GOTO E3DM4
E3DM7:
IF
CAMG X0,X1
GOTO FALSE
E3DM3:
THEN ;EL IN SECOND GROUP LESS THAN EL IN FIRST GROUP
ST X3,YZDMI(X5)
ADDI X3,3
HRRZ X1,ZDM(X3)
CAML X3,YDMB2
LI X1,-1
ELSE
;FIRST LINE NUMBERS ARE EQUAL
HRRZ X7,ZDM+1(X2) ;COMPARE INDEX OF SECOND LINE NUMBERS
HRRZ X10,ZDM+1(X3)
CAMGE X7,X10
GOTO E3DM2
CAME X7,X10
GOTO E3DM3
L X7,ZDM+1(X2)
CAMG X7,ZDM+1(X3)
GOTO E3DM2
GOTO E3DM3
FI
E3DM4:
HRRZ X10,X5
CAIL X10,QLDM/3-1
HRRI X5,-1
AOBJN X5,E3DM5
GOTO E3DM1
E3DM6:
;YZDMI NOW CONTAINS THE INDEXES OF ELEMENTS IN ZDM
HRR X5,X4 ;INDEX OF FIRST EL
MOVN X0,YDMEND
IDIVI X0,3
HRL X5,X0
LI X0,QLDM/3-1
SETZB X3,X10
LOOP
L X2,YZDMI(X5)
LD X6,ZDM(X2)
STD X6,YZDM(X3)
L X1,ZDM+2(X2)
ST X1,YZDM+2(X3)
;IF LAST LINE OF ERROR NUMBER LESS THAN PRECEDING ONE
;THEN LAST LINE:= PRECEDING LINENUMBER
TLZ X7,-1
SKIPE X3
HRRZ X10,YZDM-3+1(X3)
CAMGE X7,X10
HRRM X10,YZDM+1(X3)
;CHECK THAT LAST LINE NUMBER OF MESSAGE >=FIRST ONE
TLZ X6,-1
IF
CAMG X6,X7
GOTO FALSE
THEN
;LAST LINE NUMBER TOO SMALL
HRRM X6,YZDM+1(X3)
IFN QDEBUG,<SKPINC
NOP
OUTSTR [ASCIZ /LAST LINE NUMBER IN ERROR MESSAGE LESS THAN FIRST ONE
/]>
FI
ADDI X3,3
AS
CAIN X0,(X5)
TRO X5,-1
AOBJN X5,TRUE
SA
HRRZI X3,ZDM
L X2,YDMEND
ADD X2,X3
HRLI X3,YZDM
BLT X3,-1(X2)
E3DME:
RETURN
EPROC
SUBTTL E3EM
;PURPOSE: THIS ROUTINE USES AN INDEX TO ZDM, WHICH WILL BE
;======= IN AC XDM2 AT THE TIME OF CALL,
; AND, WITH THE AID OF TABLES YE3D,YE3DL,YE3M,YE3MI,
; PRODUCES AN ERROR MESSAGE IN ASCII,
; WHICH IS PLACED IN YE3LIN AND YE3ERR. THE NUMBER
; OF CHARACTERS IN YE3LIN IS STORED IN YE3LS3
; AND THE NUMBER OF GENERATED <CR><LF>:S IS
; SUBTRACTED FROM YE3PNO
;ENTRY: E3EM
;INPUT ARGUMENT: AC XDM2 CONTAINING INDEX OF ZDM
;NORMAL EXIT: RETURN
;OUTPUT ARGUMENTS: ERROR MESSAGE IN YE3LIN AND YE3ERR
;CALL FORMAT: EXEC E3EM
QIERR=530
PROC
E3EM: SAVE <X2,X3,X4,X5,X6,X7,X10,X11,X13,X14,X15>
RNAME <XDM2>,<X12>
RNAME <XERRN,XERRN1,XETYP,XE3MI,XN>,<X3,X4,X5,X13,X14>
;fetch error number from ZDM
edit(104)
LF XERRN,ZDMEN(XDM2,ZDM-1) ;[104]
;get entry from YE3MI and store in XE3MI
NUM: L X1,XERRN
IDIVI X1,2
XCT [HRLZ XE3MI,YE3MI-1(X1)
HLLZ XE3MI,YE3MI(X1)](X2)
IF JUMPN XE3MI,FALSE
THEN ;ILLEGAL ERROR NUMBER
LI XERRN,QIERR
GOTO NUM
FI
LF XETYP,ZE3ETP(,XE3MI)
IF CAIE XETYP,QT
GOTO FALSE
THEN ;termination error
SETONA Y3TMES
FI
;<CR> <LF> to LST file
L [BYTE(7)0,0,0,15,12]
ST YE3LIN
;convert and store error number and type
SETZ XERRN1,
LSHC XERRN,-6
LSH XERRN,4
LSHC XERRN,3
LSH XERRN,1
LSH XERRN1,-4
IOR XERRN,[ASCII/SIM00/]
IOR XERRN1,[ASCII/0 E /
ASCII/0 T /
ASCII/0 W /](XETYP)
STD XERRN,YE3ERR
STD XERRN,YE3LIN+1
RNAME <XLIN0,XLIN,XLIN1,XSEM,XSEM1>,<XERRN,XERRN1,XETYP,X6,X7>
;convert and store line number
edit(104)
LF XLIN0,ZDML1(XDM2,ZDM-1) ;[104]
LI XN,5
SETZB XLIN,XLIN1
LOOP JUMPE XLIN0,FALSE
IDIVI XLIN0,12
ADDI XLIN,60
LSHC XLIN,-7
AS
DECR XN,TRUE
GOTO LINE
SA
LOOP LI XLIN,40
LSHC XLIN,-7
AS
DECR XN,TRUE
SA
LINE: L XLIN0,[ASCII/LINE /]
ST XLIN0,YE3ERR+2
ST XLIN1,YE3ERR+3
ST XLIN0,YE3LIN+3
ST XLIN1,YE3LIN+4
;convert and store semicolon number
edit(104)
LF XSEM,ZDMSM(XDM2,ZDM-1) ;[104]
JUMPN XSEM,[SETZ XSEM1,
IDIVI XSEM,12
JUMPE XSEM,[ROTC XSEM,-16
IOR XSEM,[BYTE(7)72,60,40,40,40]
GOTO SSEM]
LSHC XSEM,26
LSH XSEM1,-7
IOR XSEM,XSEM1
IOR XSEM,[BYTE(7)72,60,60,40,40]
GOTO SSEM]
L XSEM,[ASCII/ /] ;suppress number
SSEM: ST XSEM,YE3ERR+4
ST XSEM,YE3LIN+5
RNAME <XIND,XIND1,XCHR,XCHR1,XLST,XTTY,XENT,XPTX,XE3M>,<XSEM,XSEM1,XLIN0,XLIN,XLIN1,X2,X10,X11,X15>
;calculate index to YE3M
LF XIND,ZE3IND(,XE3MI)
IDIVI XIND,3
;output error message
L XLST,[POINT 7,YE3LIN+5,34]
L XTTY,[POINT 7,YE3ERR+4,34]
LI 36+5
ST YE3LS3
SETOM YSIXB
;init byte pointer
L [POINT 12,ZDM+1(XDM2)]
ST YDMPT3
;get pointer to first byte and number of bytes to be processed
L XE3M,[POINT 12,YE3M(XIND)
POINT 12,YE3M(XIND),11
POINT 12,YE3M(XIND),23](XIND1)
LF XN,ZE3NBW(,XE3MI)
RNAME <XE3D>,<XE3MI>
NEW: ILDB XENT,XE3M
IF
CAIL XENT,7775
GOTO FALSE
THEN
;ORDINARY WORD
SETZ XPTX,
;scan through YE3DL until word number interval found
SCAN: LF ,ZE3ANB(XPTX)
CAMGE XENT
AOJA XPTX,SCAN
;get byte pointer to first char to be taken out of YE3D
LF ,ZE3ANB(XPTX,-1)
SUB XENT,
SOJ XENT,
IMUL XENT,XPTX
LF XCHR,ZE3ACH(XPTX)
ADD XCHR,XENT
IDIVI XCHR,6
L XE3D,[POINT 6,YE3D(XCHR)
POINT 6,YE3D(XCHR),5
POINT 6,YE3D(XCHR),11
POINT 6,YE3D(XCHR),17
POINT 6,YE3D(XCHR),23
POINT 6,YE3D(XCHR),29](XCHR1)
ELSE
;TEXT OR IDENTIFIER IS TO BE EDITED
IF
CAIN XENT,7777
GOTO FALSE
THEN
;ASCII TEXT OR NUMBER IS TO BE EDITED INTO MESSAGE
SETZM YSIXB
IF
CAIE XENT,7776
GOTO FALSE
THEN
;[45] NEW CODE TO OUTPUT ERRORMESSAGES CONTAINING NAME OF A FILE
;ADDRESS OF LOOKUP BLOCK IN ZDM+2
HLRZ XPTX,ZDM+1(XDM2)
IF
TRNE XPTX,600000
GOTO FALSE
THEN
;RIGHT HALF OF THIRD WORD IN ZDM CONTAINS ADDRESS
;SIXBIT FORMAT
SETOM YSIXB
LI XPTX,12
HRRZ XE3D,ZDM+1(XDM2)
LD X0,(XE3D) ;GET NAME
LSH X1,-6
IOR X1,[SIXBIT/./]
L XE3D,[POINT 6,Y3BUF]
STD X0,Y3BUF
ELSE
;END OF [45]
;ASCII TEXT
LI XPTX,5
L XE3D,[POINT 7,ZDM+1(XDM2)]
FI
ELSE
;BIN NUMBER, CONVERT TO ASCII
LI XPTX,4
ILDB X0,YDMPT3
EXEC E3BD
;COUNT NUMBER OF CHARACTERS
LOOP
LSHC X0,7
AS
TLNN X1,137B24
SOJA XPTX,TRUE
SA
ST X1,Y3BUF
L XE3D,[POINT 7,Y3BUF]
FI
ELSE
;IDENTIFIER OR CONTROLWORD
ILDB XE3D,YDMPT3
;NO EDITING IF INDEX = 0
JUMPE XE3D,TONEW
LSH XE3D,1
IF
CAIGE XE3D,2*Q1024
GOTO FALSE
THEN
;IDENTIFIER
ADD XE3D,[POINT 6,ZSE-4000]
ELSE
;SYMBOL IS TO BE EDITED
ADD XE3D,[POINT 6,E3CTW]
FI
;COUNT NUMBER OF CHARACTERS IN NAME
LD X0,(XE3D)
LI XPTX,1
LOOP
LSHC X0,6
AS
JUMPE X0,FALSE
CAIN X0,'&'
GOTO TRUE
AOJA XPTX,TRUE
SA
FI
FI
ADDM XPTX,YE3LS3
;transfer the word from YE3D, followed by one blank
LOOP: ILDB XE3D
SKIPE X0
SKIPE YSIXB
ADDI 40 ;convert to ASCII if SIXBIT
CAIN "&"
ILDB XE3D ;IF special character
IDPB XLST
IDPB XTTY
DECR XPTX,LOOP
SETOM YSIXB
LI " "
IDPB XLST
IDPB XTTY
AOS YE3LS3
TONEW:
DECR XN,NEW ;jump to process next byte in YE3M
edit(104)
LFE ,ZDML2(XDM2,ZDM-4) ;[104]
LF X1,ZDML2(XDM2,ZDM-1) ;[104]
IF CAMN X1
GOTO FALSE
THEN ;first error on this line
SOS YE3PNO
ELSE ;not first error
SETZM YE3LIN ;remove leading <CR> <LF>
FI
LFE ,ZDML2(XDM2,ZDM+2) ;[104]
IF CAME X1
GOTO FALSE
THEN ;more errors to follow on this line
HRREI -3
ADDM YE3LS3
L X1,[BYTE(7)15,12,0,0,0]
ELSE ;last error on this line
L X1,[BYTE(7)15,12,0,15,12]
SOS YE3PNO
FI
REP: LSHC 7
IDPB XLST
IDPB XTTY
JUMPN X1,REP
IDPB X1,XTTY
SOS YE3PNO
RETURN
EPROC
SUBTTL E3IN
;PURPOSE: READ SOURCE CODE,CREATE LINE NUMBER AND STORE IN YE3LIN,
; OUTPUT LINE TO LST FILE AND CREATE ERROR MESSAGE
;ENTRY: E3IN
;INPUT ARGUMENT: REG X1 CONTAINING CONTROLWORD FROM LS1
; YE3LIN CONTAINING BEGIN/END NO
; YE3LIP BYTE POINTER YE3LIN
; YE3LNO CURRENT LINE NUMBER
; YE3PNO NUMBER OF LINES LEFT TO PRINT ON CURRENT PAGE
;NORMAL EXIT: RETURN
;ERROR EXIT: -
;OUTPUT ARGUMENTS: -
;CALL FORMAT: EXEC E3IN
;CALLED SUBROUTINES: E3BD, E3EM, E3P2, O3RS, O3RSC, O3WS
;LOCAL JUMP TO E3IN EXISTS
E3IN::
;SAVE RECORD
ST X1,ZLEREC
IF
IFONA YE3LST
GOTO FALSE
THEN
;NO LIST FILE
AOS YE3LNO
;SAVE START ADDR OF LINE
LD X5,YBHSRC+1
ELSE
;LIST FILE IS TO BE GENERATED
SKIPG YE3PNO
;OUTPUT NEW HEADER
EXEC E3P2
L X4,YBEGNO
;CHECK IF END NUMBER IS TO BE OUTPUT BEFORE SOURCE LINE
IF
SKIPN YE3END
GOTO FALSE
THEN
;END IS TO BE OUTPUT
IF
SKIPN YE3LS3
GOTO FALSE
THEN ;BEGIN NUMBER ALREADY ON LINE
;OUTPUT TAB OR SPACE
IF ;More than 100 BEGIN's in source
CAIGE X4,^D100
GOTO FALSE
THEN ;OUTPUT TAB
LI X0," "
IDPB X0,YE3LIP
AOS YE3LS3
SETONA YE3TAB
ELSE ;OUTPUT SPACE AFTER BEGIN NO
LI X0," "
LI X1,4
SUB X1,YE3LS3
LOOP
IDPB X0,YE3LIP
AOS YE3LS3
AS
SOJG X1,TRUE
SA
FI
FI
LI X6,"E"
;OUTPUT END NUMBER
L X0,YE3END
EXEC E3BEL
SETZM YE3END
FI
LI X0," "
IDPB X0,YE3LIP
AOS YE3LS3
IF ;More than 100 BEGIN's
CAIL X4,^D100
IFONA YE3TAB
GOTO FALSE
THEN ;Store two tabs
IDPB X0,YE3LIP
AOSA YE3LS3
FI
SETOFA YE3TAB
IF
IFOFF ZLESRC
GOTO TRUE
;CHECK IF CORRECT LINE NUMBER
IFON ZLEOK
GOTO FALSE
THEN
;INCORRECT OR NO LINENUMBER IN SOURCE CODE
;CREATE LINE NUMBER
AOS YE3LNO
L X0,YE3LNO
EXEC E3BD ;CONVERT LINE NUMBER TO DEC ASCII
LOOP
LSHC X0,7
IDPB X0,YE3LIP
AS
JUMPN X1,TRUE
SA
LI X2,5
IF
IFON ZLESRC
GOTO FALSE
THEN
;TAB IF NO LINE NUMBER IN SOURCE
LI X4," "
IDPB X4,YE3LIP
LI X2,6
FI
ADDM X2,YE3LS3 ;6 BYTES INTO LINE
FI
LD X5,YBHLS3+1
IF
SKIPN YE3LS3
GOTO FALSE
THEN
;OUTPUT BEG END NUMBER AND LINE NUMBER IF EXISTING TO LS3
LI X1,YE3LIN
EXEC O3WS,<YE3LS3>
FI
FI
;SAVE ADDRESS OF LINE TO BE USED IF FAULTY LINE
STD X5,Y3LINH+1
EXEC O3RSC ;READ SOURCE CODE LINE
IF
IFOFFA YE3LST
GOTO FALSE
THEN
;SAVE POINTER TO POS AFTER CURRENT LINE
;SINCE PAGE HEADER MIGHT APPEAR IN OUTPUT BUFFER
L X0,YBHLS3+1
ST X0,Y3LINH
SOS YE3PNO
FI
CAML XDM1,YDMEND ;CHECK FOR MORE FAULTY STATEMENTS
GOTO E3IN1
HRRZ X1,ZDM(XDM1) ;CHECK IF FAULTY LINE
CAMLE X1,YE3LNO
GOTO E3IN1
;FAULTY LINE
IF
IFONA YE3TTY
GOTO FALSE
THEN
;OUTPUT ON TTY
L X0,[POINT 7,YE3LIN]
ST X0,YE3LIP
IF ;No list wanted
IFONA YE3LST
GOTO FALSE
THEN
L X0,YBHSRC+1
L X2,YBHSRC
ELSE ;Y3LINH CONTAINS POINTER TO POS AFTER CURRENT LINE
;LIST FILE
L X0,Y3LINH
L X2,YBHLS3
FI
;OUTPUT LINE REFERRING TO ERROR
LI X4,^D133
LOOP
IF
SOSGE Y3LINH+2
GOTO FALSE
THEN
;GET BYTE FROM SOURCE LINE
;AND STORE IN LOCAL BUFFER
ILDB X1,Y3LINH+1
SKIPE X1
IDPB X1,YE3LIP
ELSE
;MODIFY BYTE POINTER TO POINT TO NEXT CHAR
;IN ANOTHER BUFFER
ADDI X2,1
HRRM X2,Y3LINH+1
LI X1,5*200 ;BUFFER SIZE
ST X1,Y3LINH+2
FI
AS
CAME X0,Y3LINH+1
SOJGE X4,TRUE
LI X1,0
IDPB X1,YE3LIP
OUTSTR YE3LIN
JUMPGE X4,FALSE
L X1,[POINT 7,YE3LIN]
ST X1,YE3LIP
LI X4,^D133
GOTO TRUE
SA
FI
E3IN1:
EXEC E3ERR
HRLZ X1,ZLEREC
TLZ X1,1
SETZM YE3LS3
L X0,[POINT 7,YE3LIN]
ST X0,YE3LIP
;CHECK IF THIS LINE WAS NOLIST
IFONA YE3OPL
SETOFA YE3LST
JUMPN X1,E3IN
RETURN
E3ERR:
;CHECK IF ERROR MESSAGE AFTER THIS LINE (INCLUDING LINE NO 0)
IF
CAML XDM2,YDMEND
GOTO FALSE
THEN
WHILE
HRRZ X2,ZDM(XDM2) ;CHECK IF ERROR MESSAGE AFTER THIS LINE
CAME X2,YE3LNO
GOTO FALSE
DO
E3ERRE:
;ERROR MESSAGE AFTER THIS LINE
IF
IFOFFA YE3LST
GOTO FALSE
THEN
;LIST FILE
SKIPG YE3PNO
;OUTPUT HEADER
EXEC E3P2
FI
;YE3PNO IS UPDATED IN E3EM
EXEC E3EM ;CREATE ERROR MESSAGE
IFOFFA YE3TTY
OUTSTR YE3ERR
IF
IFOFFA YE3LST ;OUTPUT MESSAGE IF LIST WANTED
GOTO FALSE
THEN
LI X1,YE3LIN
EXEC O3WS,<YE3LS3>
SETZM YE3LS3 ;[170]
FI
CAMG XDM1,XDM2
ADDI XDM1,3
ADDI XDM2,3 ;POINT TO NEXT MESSAGE
CAMG XDM2,YDMEND
OD
FI
IFONA YE3LAS
;OUTPUT PAGE HEADER
EXEC E3PAGE
L X0,[POINT 7,YE3LIN]
ST X0,YE3LIP
RETURN
SUBTTL E3LI
COMMENT ;
PURPOSE: INTERPRET CONTROL WORD FROM LS1
UPDATE PAGE NUMBER AT FORM FEED
ENTRY: E3LI
INPUT ARGUMENT: X1 CONTAINS CONTROL WORD
NORMAL EXIT: RETURN
ERROR EXIT: -
OUTPUT ARGUMENTS: SWITCHES INDICATING STATUS
AND LOOKUP ARG SOURCE
THE FOLLOWING SWITCHES ARE SET IN CASES LISTED BELOW
AND SET OFF IN OPPOSITE CASES
YE3LAS FF,PAGE
YE3TTY NO ERRORS ON TTY
YE3LST LIST
YE3OPL NO LIST
E3LI CONTAINS THE FOLLOWING SUBROUTINES:
E3LICF FORM FEED CALLED FROM O3RSC IN O3
E3LICP PAGE
E3LICN N SIWTCH
E3LICL LIST
E3LICS INF OF SOURCE
CALL FORMAT: EXEC E3LI
;
E3LI:: PROC
SAVE <X2>
LI X0,0
WHILE
;CHECK IF NUMBER BEFORE SWITCH
JUMPLE X1,FALSE
DO
LSHC X0,7
OD
TRZ X1,-1
TLZ X1,3777
LI X2,4
IF
CAMN X1,E3LIC(X2)
GOTO FALSE
THEN
SOJGE X2,.-2
IFN QDEBUG,<SKPINC
NOP
OUTSTR [ASCIZ /FAULTY RECORD IN LS1/]>
ELSE
EXEC @E3LIC1(X2)
FI
RETURN
EPROC
E3LICP: ;PAGE
IF
JUMPE X0,FALSE
THEN ;STORE NEW VALUE OF LINES PER PAGE
LSH X0,1
EXEC E3DB
ST X1,YE3PAG
FI
edit(7)
;[7] Update main page number
;i.e. same action as for E3LICF
E3LICF: SETONA YE3LAS ;FORM FEED UPDATE MAIN NUMBER OF PAGE
HRLZI X0,1
ADD X0,YE3PGN
HLLZM X0,YE3PGN
RETURN
E3LICN: ;ERRORS TERMINAL T/F
IF CAIE X0,"-"
GOTO FALSE
THEN ;ALLOW ERRORS ON TTY
SETOFA YE3TTY
ELSE
SETONA YE3TTY ;NO ERRORS ON TTY
FI RETURN
E3LICL: ;LIST T/F
IF CAIE X0,"-"
GOTO FALSE
THEN
;NO LIST OPTIONS(-L) IS PRINTED
SETONA YE3OPL
ELSE
IFOFF YOPLST
EXEC I3LS3 ;OPEN LIST FILE
SETONA YE3LST ;LIST
SETOFA YE3OPL
FI
RETURN
E3LICS: ;S RECORD
;READ DEVICE OF SOURCE
EXEC O3RS
ST X1,Y3DEV
edit(144)
;[144] Read lookup info for source code file
EXEC O3RS ;[144] File name
ST X1,YELSRC
EXEC O3RS ;[144] Extension
ST X1,YELSRC+1
EXEC O3RS ;[144] ppn
edit(225)
TOPS10,<;[225]
IF ;[144] SFD path follows, i e ppn = [-n,,0]
SKIPE X2,X1
TRNE X1,-1
GOTO FALSE
THEN ;Copy ppn, SFD name list to Y3SFD
SETZM Y3SFD
SETZM Y3SFD+1
HRRI X2,Y3SFD+2 ;AOBJN word, n=SFD path depth+1
LOOP
EXEC O3RS
ST X1,(X2)
AS
AOBJN X2,TRUE
SA
SETZM (X2) ;Zero finishes list
LI X1,Y3SFD ;Replace ppn by path block ptr
FI ;[144]
>;[225]
SETZM YELSRC+2
ST X1,YELSRC+3
ST X1,YE3PNN ;[144] Preserve over lookup
;IF NOLIST IN CUSP,NO PRINTING
IFONA YE3OPL
SETOFA YE3LST
EXEC I3S ;OPEN INPUT FILE
EXEC E3PAGH ;GENERATE PAGE HEADER
edit(7)
;[7] UPDATE MAIN PAGE NUMBER. DO NOT CALL E3PAGE
; BUT ZERO YE3PNO TO LET NEXT LINE GENERATE A NEW
; PAGE. SECONDARY PAGE NUMBER(RIGHT HALF OF YE3PGN)
; IS SET TO -1 SINCE A AOS IS PERFORMED BEFORE THE
; NEW PAGE IS GENERATED, AND THIS WILL INCREASE
; MAIN PAGE NUMBER AND ZERO SECONDARY PAGE NUMBER.
HLLOS YE3PGN
SETZM YE3PNO
; END [7]
EXEC E3ERR
RETURN
SUBTTL E3LT
;PURPOSE: CREATE LINENUMBER TABLE AND OUTPUT TO LISTFILE
;ENTRY: E3LT
;INPUT ARGUMENTS: Y3PLTS POINTER START OF LINE NUMBER TABLE
; Y3PLTE POINTER END OF LINE NUMBER TABLE
;NORMAL EXIT: RETURN
;ERROR EXIT: -
;OUTPUT ARGUMENTS: -
;CALL FORMAT: EXEC E3LT
E3LT:
PROC
;CREATE HEADER AND OUTPUT IT
LI X1,YE3RUB
HRLI X1,E3LTAB
BLT X1,YE3RUB+3
LI X0,4
ST X0,YE3NRU
HLRZ X0,YE3PGN
ADDI X0,1
MOVSM X0,YE3PGN
EXEC E3PAGE
;SET INITIAL VALUES
;NUMBER OF LINES ON CURRENT PAGE
LI X5,QPAGE-3
;INDEX LOCAL BUFFER
LI X3,0
;LET X7 AND X10 CONTAIN TAB RESP CRLF
LI X7,QHT
LI X10,QCRLF
LSHC X7,1
;COMPUTE NUMBER OF WORDS IN TABLE
L X12,Y3PLTE
SUB X12,Y3PLTS
L X11,Y3PLTS
L X13,X11
;TREAT LINE NUMBERS ON ONE PAGE
;5 COLUMNS WITH N NUMBERS IN EACH COLUMN
;WHERE N=DEFAULT NUMBER OF LINES PER PAGE-3
;THE LINE NUMBERS ARE OUTPUT IN INCREASING ORDER COLUMNWISE
;CREATE POINTER TO POS AFTER LAST EL IN LINENUMBER TABLE
LI X0,5*<QPAGE-3>(X11)
CAMGE X0,Y3PLTE
ST X0,Y3PLTE
LOOP
;GET LINENUMBER
HLRZ X0,(X11)
;GET RID OF BIT FROM DECLARATION ENTRY
TRZ X0,200000
;SET MAX VALUE TO ZERO IF -I SWITCH IS SET
XORI X0,177777
SKIPE X0
XORI X0,177777
;CONVERT TO ASCII
EXEC E3BD
ST X1,Y3BUF(X3)
LI X2,3
LI X0,QHT
HRLZ X1,(X11)
;CONVERT ADDRESS TO OCTAL ASCII
LOOP
LSH X0,4
LSHC X0,3
ADDI X0,60
AS
SOJGE X2,TRUE
SA
LSH X0,1
ST X0,Y3BUF+1(X3)
;CONVERT REMAINING DIGITS IN ADDRESS
LOOP
LSH X0,4
LSHC X0,3
ADDI X0,60
AS
AOJE X2,TRUE
SA
LSH X0,1+3*7
ST X0,Y3BUF+2(X3)
;COMPUTE ADDRESS OF NEXT NUMBER ON CURRENT LINE
ADDI X11,QPAGE-3
ADDI X3,3
IF
CAML X11,Y3PLTE
GOTO FALSE
THEN
;ELEMENT IS NOT IN LAST COLUMN
;MORE NUMBERS ON LINE, OUTPUT TAB
IORM X7,Y3BUF-1(X3)
ELSE
;NO MORE ELEMENTS ON CURRENT LINE, OUTPUT LINE
IORM X10,Y3BUF-1(X3)
LI X1,Y3BUF
IMULI X3,5
;OUTPUT LINE TO LIST FILE
EXEC O3WS,<X3>
LI X3,0
IF
SOJG X5,FALSE
;NO HEADER IF LAST NUMBER
CAIG X12,1
GOTO FALSE
THEN
;NEW PAGE, OUTPUT HEADER
EXEC E3P2
;5 GROUPS OF QPAGE-3 ELEMENTS ARE TREATED
;TREAT NEXT GROUP
SUBI X11,-1+QPAGE-3
L X13,X11
LI X5,QPAGE-3
;COMPUTE ADDRESS OF LAST ELEM ON CURRENT PAGE
LI X0,5*<QPAGE-3>
CAIGE X12,5*<QPAGE-3>
L X0,X12
ADDM X0,Y3PLTE
ELSE
AOS X11,X13
FI
FI
AS
SOJG X12,TRUE
SA
RETURN
EPROC
SUBTTL E3PAGE
;PURPOSE: GENERATE FINAL PAGE HEADER OUTPUT TO LIST
;ENTRY: E3PAGE TO GENERATE PAGE HEADING
; E3P2 TO UPDATE SECONDARY NUMBER OF PAGE
;INPUT ARGUMENTS: YE3PGN CURRENT PAGE NUMBER
; YE3PGH STANDARD HEADER PART 1
; YE3PNM STANDARD HEADER PART 2
; YE3PNN NUMBER OF BYTES IN YE3PNM
; YE3RUB TEXT FROM PAGE SWITCH
; YE3NRU NUMBER OF WORDS IN YE3RUB
;OUTPUT ARGUMENTS: HEADER IN LIST FILE
;NORMAL EXIT: RETURN
;ERROR EXIT: -
;CALLED SUBROUTINES: O3WS
;CALL FORMAT: EXEC E3P2 RESP EXEC E3PAGE
E3P2: ;UPDATE SECONDARY PAGE NUMBER
AOS YE3PGN
E3PAGE::
SAVE <X2,X3>
SETOFA YE3LAS
HRRZS YE3NRU ;NEW PAGE TEXT ALLOWED
IFOFFA YE3LST
GOTO E3PAG1
LI X1,YE3PGH
;OUTPUT STANDARD PART OF HEADING
EXEC O3WS,<[^D80]>
HLRZ X0,YE3PGN
EXEC E3BD
IF HRRZ X0,YE3PGN
JUMPE X0,FALSE
THEN LSH X1,7
IORI X1,"-"B34
ST X1,Y3BUF
EXEC E3BD
WHILE
TLNE X1,20B24
GOTO FALSE
DO
LSH X1,7
OD
ELSE
SETZM Y3BUF
FI ST X1,Y3BUF+1
LI X1,Y3BUF
L X2,E3CR
ST X2,Y3BUF+2
EXEC O3WS,<[^D12]>
;OUTPUT NAME OF FILE ETC
LI X1,YE3PNM
EXEC O3WS,<YE3PNN>
IF
SKIPN X2,YE3NRU
GOTO FALSE
THEN
LI X1,YE3RUB ;OUTPUT TEXT FROM PAGE SWITCH
IMULI X2,5
EXEC O3WS,<X2>
FI
LI X1,E3CR
EXEC O3WS,<[4]>
L X0,YE3PAG
SUBI X0,3
ST X0,YE3PNO
E3PAG1:
HRROS YE3NRU
RETURN
SUBTTL E3PAGH
;PURPOSE: GENERATE HEADER OF PAGE
;ENTRY: E3PAGH
;INPUT ARGUMENTS: -
;NORMAL EXIT: RETURN
;OUTPUT ARGUMENTS: -
;CALL FORMAT: EXEC E3PAGH
E3PAGH:
PROC
SAVE <X3,X4>
;GENERATE STANDARD PART OF HEADER AND OUTPUT TO LOCAL BUFFER
LI X1,YE3PGH
HRLI X1,E3SIM
BLT X1,YE3PGH+10
edit(217)
edit(225)
TOPS20,<;[217,225]
LI "2"
DPB [$HD10(YE3PGH)] ;Change "10" to "20"
>
EXEC E3PVER ;[217] VERSION
;COMPUTE DATE
DATE X2,
LI X4,YE3PGH+11
EXEC E3PDAT
;COMPUTE TIME
MSTIME X2,
LI X4,YE3PGH+14
EXEC E3PTIM
;OUTPUT PAGE
LI X1,YE3PGH+16
HRLI X1,E3SIPA
BLT X1,YE3PGH+17
L X3,[POINT 7,YE3PNM]
L X1,Y3DEV ;[225]
IF ;[225] Device is not DSK
IFE QDIRTR,<
CAMN X1,[SIXBIT"DSK "]
GOTO FALSE >
THEN ;Output dev:
EXEC E3PSA
LI ":"
IDPB X3
L X1,X3
SETZ
IDPB X1 ;[225] Closing null
FI
edit(225)
IFN QDIRTR,<;[225] Output any <directory>
L X2,YE3PNN
IF ;Explicit directory was given for source file
JUMPE X2,FALSE
THEN ;Output str:<directory>
LD YE3PNM
STD 3(XPDP) ;Copy "DEV:..."
HRROI X3,3(XPDP) ;To stack
HRROI X1,YE3PNM
PPNST%
ERJMP [LI "?"
L X1,X3
IDPB X1
GOTO .+1]
L X3,X1 ;Updated byte pointer
SETZ
WHILE ;Not on word boundary
TLNN X3,(3B2)
GOTO FALSE
DO ;Pad with <NULL>
IDPB X3
OD
FI
>;[225]
;CONVERT NAME OF FILE FROM SIXBIT TO ASCII
SETZM 2(X3) ;[225]
L X1,YELSRC
;CONVERT FILE NAME
EXEC E3PSA
;CONVERT EXTENSION
edit(4)
HLLZ X1,YELSRC+1 ;[4]
IF ;EXT exists
JUMPE X1,FALSE
THEN ;Output it
LI X0,"."
IDPB X0,X3
EXEC E3PSA
FI
edit(225)
IFE QDIRTR,<;[225]
IF ;[144] not default path for source file
SKIPN X4,YE3PNN
GOTO FALSE
THEN ;Convert path specification
LI X0,"["
IDPB X0,X3
HRRI X4,YE3PNN
TLZN X4,-1
LI X4,Y3SFD+2
HLRZ X0,(X4)
EXEC E3PPN
LI X0,","
IDPB X0,X3
HRRZ X0,(X4)
EXEC E3PPN
IFE QDEC20,<;[225]
IF ;SFD path given
CAIE X4,Y3SFD+2
GOTO FALSE
THEN ;Output path specification
LOOP
L X1,1(X4)
JUMPE X1,FALSE
LI X0,","
IDPB X0,X3
EXEC E3PSA
AS
AOJA X4,TRUE
SA
FI
>
LI X0,"]"
IDPB X0,X3
FI ;[144]
>;[225]
LI X0,QHT
IDPB X0,X3
LI X4,1(X3) ;Pad to word boundary
LI X0,0
WHILE CAIN X4,(X3)
GOTO FALSE
DO
IDPB X0,X3
OD
;COMPUTE NUMBER OF CHARACTERS IN SECOND PART OF HEADER
;COMPUTE CREATION DAY OF FILE
edit(5)
;[5] DATE 75 ERROR Use also HIGH DATE 2 to compute creation day
HRRZ X0,YELSRC+1
LSH X0,-3
TRZ X0,707777
HRRZ X2,YELSRC+2
TRZ X2,770000
IOR X2,X0 ;[5]
EXEC E3PDAT
;COMPUTE CREATION TIME OF FILE
L X2,YELSRC+2
TLZ X2,777740
LSH X2,-^D12
ADDI X4,3
EXEC E3PTIM
SUBI X4,YE3PNM-2
IMULI X4,5
ST X4,YE3PNN
RETURN
EPROC
E3PPN: ;Convert 2:nd halfword of X0 to octal ASCII and output to header
edit(275) ;[275]
IF ;Non-zero
JUMPE FALSE
THEN ;Use "OUTINT"
EXCH X1,X3
HRRZ X2,X0
LI X3,8
OUTINT
CAI
EXCH X1,X3
FI
RET
E3PSA:
LOOP
LI X0,0
LSHC X0,6
ADDI X0,40
IDPB X0,X3
AS
JUMPN X1,TRUE
SA
RETURN
SUBTTL E3PDAT
;PURPOSE: COMPUTE DATE AND TIME AND CONVERT TO ASCII
;ENTRY: E3PDAT COMPUTE DAY
; E3PTIM COMPUTE TIME
;INPUT ARGUMENTS: E3PDAT: REG X2 CONTAINING DATE
; E3PTIM: REG X2 CONTAINING TIME
; REG X4 ADDRESS OF LOCAL BUFFER WHERE TO PUT CONVERTED TIME
;NORMAL EXIT: RETURN
;OUTPUT ARGUMENTS: -
;CALL FORMAT: EXEC E3PDAT RESP EXEC E3PTIM
E3PDAT:
PROC
SAVE <X3,X4>
IDIVI X2,^D31
LI X0,1(X3)
EXEC E3BD ;CONVERT DAY TO ASCII
LSH X1,7
IORI X1,"-"B34
ST X1,(X4)
;COMPUTE MONTH
IDIVI X2,^D12
L X3,E3MON(X3)
ST X3,1(X4)
;COMPUTE YEAR
LI X0,^D1964(X2)
EXEC E3BD
LSH X1,7
ST X1,2(X4)
RETURN
EPROC
SUBTTL E3PTIM
E3PTIM:
PROC
SAVE <X3,X4>
;COMPUTE TIME
CAIL X2,^D60000 ;SKIP NEXT INSTR IF TIME IN MINUTES
IDIVI X2,^D60000 ;TIME IN MILLI SECONDS
IDIVI X2,^D60
L X0,X2
;CONVERT HOURS TO ASCII
EXEC E3BD
LSH X1,7
IORI X1,":"B34
ST X1,(X4)
L X0,X3
;CONVERT MINUTES TO ASCII
EXEC E3BD
LSH X1,^D21
TLO X1,20B24
TRO X1,<QHT>B34
ST X1,1(X4)
RETURN
EPROC
SUBTTL E3PVER ;[217]
edit(217)
Comment;
Purpose: Edits .JBVER in the form 777BK(777777)-7
(maximal value corr to 777777,,777777) into
the page heading.
;
E3PVER: PROC
edit(275)
SAVE <X1,X2,X3> ;[275]
LDB X2,[POINT 9,.JBVER,11] ;MAIN VERSION NO
L X1,[$HDVER(YE3PGH)]
LI X3,8
OUTINT
CAI ;ERROR, SO WHAT?
LDB X2,[POINT 6,.JBVER,17] ;MINOR VERSION NO
IF ;NON-ZERO
SOJL X2,FALSE
THEN ;CONVERT TO AT MOST 2 CODE LETTERS
IDIVI X2,"Z"-"A"+1
IF ;MORE THAN ONE LETTER NEEDED
JUMPE X2,FALSE
THEN ;OUTPUT FIRST LETTER
LI "A"-1(X2)
IDPB X1
FI
LI "A"(X3)
IDPB X1
FI
HRRZ X2,.JBVER ;EDIT NO
IF ;NON-ZERO
JUMPE X2,FALSE
THEN ;OUTPUT (777777)
LI "("
IDPB X1
LI X3,8
OUTINT
CAI
LI ")"
IDPB X1
FI
LDB X2,[POINT 3,.JBVER,2] ;WHO
IF JUMPE X2,FALSE
THEN ;OUTPUT -D
LI "-"
IDPB X1
LI "0"(X2)
IDPB X1
FI
RETURN
EPROC
SUBTTL E3PNOU [217,225]
edit(225)
edit(217)
TOPS10,<;[225]
Comment;
Purpose: To output a number in radix 2-36 to a string.
Input: X1 = pointer to ASCII string.
X2 = number to output.
X3 = Radix (2-36)
Output: X1 updated to point to rest of string.
;
E3PNOU: PROC
edit(275)
SAVE X4 ;[275]
n==1 ;[275]
L X4,X3
XEC L1
AOS -n(XPDP) ;[275] Always "success" return (emulate NOUT)
RETURN
L1():! IDIVI X2,(X4)
HRLM X3,(XPDP)
SKIPE X2 ;[275]
XEC L1
HLRZ X2,(XPDP)
ADDI X2,"0"
CAILE X2,"9"
ADDI X2,"A"-"9"-1 ;Use 0-9,A-Z
IDPB X2,X1
RET
EPROC
>
E3LIC: ASCIZ /N/
ASCIZ /L/
ASCIZ /S/
ASCIZ /P/
E3LIC1: XWD 0,E3LICN
XWD 0,E3LICL
XWD 0,E3LICS
XWD 0,E3LICP
E3LTAB: ASCII / LINE NUMBER TABLE/
E3CR: ASCIZ /
/
E3MON: ;Months in standard text
ASCII /JAN-/
ASCII /FEB-/
ASCII /MAR-/
ASCII /APR-/
ASCII /MAY-/
ASCII /JUN-/
ASCII /JUL-/
ASCII /AUG-/
ASCII /SEP-/
ASCII /OCT-/
ASCII /NOV-/
ASCII /DEC-/
E3SIM: VERLST ;Standard part of header
E3SIPA: ASCII / PAGE/
E3CTW: SYMB 7,1,ERRSY
LIT
END