Trailing-Edge
-
PDP-10 Archives
-
decuslib10-10
-
43,50516/baserr.mac
There are no other files named baserr.mac in the archive.
SUBTTL ERROR MESSAGE SEGMENT
;FOR SEGMENTED BASIC ONLY
IFNDEF NOCODE,<NOCODE==0> ;NOCODE=1 : JUST DEFINE SYMBOLS
IFE NOCODE,< TITLE BASERR ERROR SEGMENT>
IFN NOCODE,< UNIVERSAL BSYERR>
EXTERN .JBSA,.JBREL,.JB41,FILDIR,IOW,SVDV,MONLVL
EXTERN ERRTCN,ERRTBL,SAVRUN
INTERN ERRTTY,SAVE,TIMOUT
SEARCH BSYXCT
.JBS41=122
.JBCOR=133
CH=1
PNT=4 ;RH = ADDRESS TO STORE DATA -1
;LH = NEGATIVE # OF DATA WORDS
PNTX=5 ;INITIAL AOBJN POINTER
ADR=6 ;CURRENT POINTER
LIMIT=7 ;END OF AREA TO SAVE
OUTPNT=10
X1=13
X2=14
P=17
IFE NOCODE,<HISEG>
IFN NOCODE,<LOC 400010
IF2,<
END>
>
;GENERATE THE TRANSFER ADDRESS TABLE
RADIX 10
DEFINE MESADD(A)
< XWD 0,EMS'A>
%N==1
REPEAT ERRNUM,<MESADD(\%N)
%N==%N+1>
RADIX 8
ERRTTY: PUSH P,X1 ;ENTER HERE, SAVE AN AC
SKIPN X1,ERRTCN ;GET ERROR COUNT
JRST ERREND ;NONE, JUST RETURN
MOVNS X1
HRLZS X1 ;SET FOR AOBJN
ERROUT: TTCALL 3,@ERRTBL(X1) ;PUT OUT MESSAGE
AOBJN X1,ERROUT ;AND ANY MORE
SETZM ERRTCN ;ZERO COUNT
ERREND: POP P,X1 ;RESTORE AC
POPJ P, ;AND RETURN
TIMOUT: SKIPN MTIME ;ANY TIME TO RECORD ?
POPJ P, ;NO, JUST RETURN
TTCALL 3,[ASCIZ /
Time: /]
SETZ X1,
PUSH P,X1 ;ZERO ON STACK AS DELIMITER
RUNTIM X1, ;GET RUN TIME
SUB X1,MTIME ;SUBTRACT START TIME
IDIVI X1,^D10 ;SHAVE THOUSANDTHS
IDIVI X1,^D100 ;SPLIT TO FRACTION
PUSH P,X1 ;SAVE WHOLE NO
MOVE X1,X2
IDIVI X1,^D10 ;TENTHS & HUNDREDTHS
ADDI X1,"0" ;TO ASCII
ADDI X2,"0"
EXCH X2,(P) ;/100'S TO STACK, NUMBER BACK
PUSH P,X1 ;/10'S TO STACK
MOVEI X1,"."
PUSH P,X1
MOVE X1,X2
STIME: IDIVI X1,^D10 ;SHAVE DIGIT
ADDI X2,"0" ;TO ASCII
PUSH P,X2
JUMPN X1,STIME ;GET MORE
STIM1: POP P,X1
TTCALL 1,X1 ;PUT THEM OUT
JUMPN X1,STIM1 ;AND THE REST
TTCALL 3,[ASCIZ / secs.
/]
POPJ P, ;RETURN
SAVE: HRRZ X1,.JBREL ;JOBREL
HRRZ X2,.JBFF ;JOBFF
SUB X1,X2 ;NUMBER OF FREE LOCATIONS
CAIL X1,^D128 ;NEED 128 FOR SAVE OUTPUT BUFFER
JRST OKCOR ;OK. WE HAVE IT
HRRZ X1,.JBREL ;JOBREL
ADDI X1,^D1024 ;+ 1K
CORE X1, ;CORE UUO
JRST CORERR ;NO MORE CORE
OKCOR: HRRZ PNTX,.JBFF ;BUFFER STARTS AT .JBFF
HRR X1,.JBFF ;.JBFF
SOJ X1, ;-1
HRLI X1,-^D128 ;128 WORDS
MOVEM X1,IOW ;IO WORD FOR SAV FILES
HRLI PNTX,-^D128 ;128 WORD BUFFER
MOVE X1,SAVRUN ;GET SAVED FILE NAME
MOVEM X1,FILDIR ;SET UP IN CASE CLOBBERED
HRLZI X1,(SIXBIT/SAV/) ;EXTENSION FOR SAVE FILE
MOVEM X1,FILDIR+1 ;PUT IN EXTENSION WORD
SETZM FILDIR+2 ;ENTER BLOCK+2
SETZM FILDIR+3 ;SAV IN USERS AREA
OPEN CH,SVDV ;OPEN UP DSK MODE 17
JRST OPNERR ;CAN'T GET DSK
ENTER CH,FILDIR ;
JRST ENTERR ;CAN'T DO ENTER
HRRZ LIMIT,.JBFF ;UPPER LIMIT TO SAVE
MOVE X1,.JB41 ;PICK UP JOB41
MOVEM X1,.JBS41 ;SAVE HIGHER UP
HRRZ X1,.JBREL ;GET NUM K FOR LOW SEGMENT
HLL X1,.JBSA ;GET HIGHEST LOWSEGMENT ADDRESS
MOVEM X1,.JBCOR ;SAVE HIGHER UP
MOVEI ADR,116 ;START SAVE AT JOBSYM
MOVE OUTPNT,PNTX ;INITIALIZE OUTPUT POINTER
LP20: SKIPN @ADR ;NON ZERO?
AOJA ADR,LP20 ;NO
LP3: MOVEM ADR,PNT ;YES. FIRST DATA WORD
SUBI PNT,1 ;ADDRESS -1
LP1: SKIPN @ADR ;NON ZERO?
JRST ZER ;NO. GO WRITE BLOCK
AOS ADR ;INCREMENT ADDRESS POINTER
CAMGE ADR,LIMIT ;REACHED LIMIT?
JRST LP1 ;NO. KEEP LOOKING
PUSHJ P,OUTSV ;YES. OUTPUT WHAT WE HAVE
EX1A: HRLZI X1,(JRST) ;SET UP JRST TO JOBSA FOR TENDMP
HRR X1,.JBSA ;JOBSA ADDRESS
MOVEM X1,0(OUTPNT) ;PUT IN OUTPUT BUFFER
AOBJP OUTPNT,LPX1 ;INCREMENT POINTER TO OUTPUT BUFFER
LP2: SETZM 0(OUTPNT) ;CLEAR REST OF BUFFER
AOBJN OUTPNT,LP2 ;CLEAR WHOLE BUFFER YET?
LPX1: OUT CH,IOW ;OUTPUT BUFFER
JRST RNEXSV ;RELEASE AND EXIT ROUTINE
JRST OUTRRE ;OUTPUT ERROR
ZER: PUSHJ P,OUTSV ;OUTPUT BLOCK OF DATA
ZER1: AOS ADR ;INCREMENT ADDRESS POINTER
CAML ADR,LIMIT ;END OF LO SEG YET?
JRST EX1A ;YES. EXIT ROUTINE
SKIPN @ADR ;REACHED NEXT NON ZERO WORD?
JRST ZER1 ;NO
JRST LP3 ;YES. GO COUNT NEXT BLOCK
OUTSV: MOVE X1,ADR ;CURRENT POINTER
SUB X1,PNT ;SUBTRACT BEGIN POINTER
SOS X1 ;CORRECT TO NUMBER OF WORDS IN BLOCK
MOVNS X1 ;MAKE NEGATIVE
HRLM X1,PNT ;SETUP IOWD FOR SAVE FILE DATA BLOCK
MOVEM PNT,0(OUTPNT) ;STORE IOWD IN BUFFER
AOBJN OUTPNT,OUTBF ;INCREMENT BUFFER POINTER
OUT CH,IOW ;OUTPUT BUFFER
CAIA ;OK RETURN
JRST OUTRRE ;ERROR ON OUTPUT TO DSK
MOVE OUTPNT,PNTX ;INIT BUFFER POINTER
OUTBF: HRRZ X1,PNT ;PICK UP BEGIN ADDRESS -1
BUFLP: AOJ X1, ;INCREMENT TO NEXT ADDRESS
CAML X1,ADR ;END OF DATA BLOCK?
POPJ P, ;YES
MOVE X2,0(X1) ;NO. PICK UP DATA WORD
MOVEM X2,0(OUTPNT) ;STORE IN OUTPUT BUFFER
AOBJN OUTPNT,BUFLP ;LOOP UNLESS BUFFER FULL
MOVE OUTPNT,PNTX ;INIT BUFFER POINTER
OUT CH,IOW
JRST BUFLP ;OK RETURN FROM OUT
OUTRRE: TTCALL 3,MESS ;OUT UUO ERROR TO DISK
JRST EXSV ;?????
MESS: ASCIZ /
? Disk write error
/
CORERR: TTCALL 3,MESS1 ;CORE UUO ERROR
JRST EXSV ;??????
MESS1: ASCIZ /
? Not enough core
/
ENTERR:
OPNERR: TTCALL 3,MESS2 ;DSK INIT ERROR
JRST EXSV ;??????
MESS2: ASCIZ /
? Cannot access disk
/
RENERR: TTCALL 3,MESS3 ;RENAME ERROR
JRST EXSV ;??????
MESS3: ASCIZ /
? File saved but not preserved
/
RNEXSV: CLOSE CH, ;CLOSE FOR RENAME
HLLZS FILDIR+1
SETZM FILDIR+2
SETZM FILDIR+3
LOOKUP CH,FILDIR
JRST ENTERR
HLLZ X1,FILDIR+2
TLZ X1,777
SKIPL MONLVL ;MONLVL HAS 4/5 SERIES PROT BIT
TLNN X1,700000
IOR X1,MONLVL ;SET FOR NO DELETE
MOVEM X1,FILDIR+2
HLLZS FILDIR+1
RENAME CH,FILDIR
JRST RENERR
EXSV: RELEASE CH, ;RELEASE SAVE CHANNEL
POPJ P, ;RETURN
;NOW GENERATE THE ERROR TEXT MACROS DEFINED IN THE EXECUTE PHASE
RADIX 10
DEFINE MESSAG(A)
< ERM'A>
%N==1
REPEAT ERRNUM,<MESSAG(\%N)
%N==%N+1>
END