.
. MAIN CONTROL ELEMENT
.
.
.
. (C) Copyright 1972-1978 John Walker
.
. This software is in the public domain
.
AXR$
DEFUNCT$
FANG
.
AUTODUMP EQU 0 TURN OFF UNTIL UNIVAC FIXES EABT$ CGY
TDATE EQU R7 TDATE$ FORMAT DATE AND TIME
.
. FANG receives control at 'BEGIND'. This simply jumps into the
. initially-based common instruction bank.
.
impure code
.
begind* j begin enter instruction bank
.
PURE CODE
.
BEGIN* GETTIME STARTTIME SAVE START TIME OF PROCESSOR
ON TSQ
TSQRG$ . REGISTER FOR TEST AND SET QUEUEING
OFF TSQ
SA A5,A15 SAVE OPTIONS
if jwsite
JNB A15,$+2 'Z' OPTION SET ?
SA A15,BTRACE YES. TRACE BGET CALLS
endf
LR R15,(' ') SET UP STORE-NOT-ZERO
SA A15,PARTBL MAKE IT LOOK LINE A PROCESSOR
SR R2,TDATE SAVE STARTING DATE AND TIME
TOP A15,(BIT(34)) IS THE OUTPUT FILE BREAKPOINTED ?
TEP,U A15,OPTION('X') IS BATCH SIMULATION SPECIFIED ?
LA,U A4,6 YES. MAKE IT BATCH
TNE,U A4,4 DEMAND ?
SA A4,DEMAND YES. SET DEMAND FLAG
RDI READ$ LINE,AWAY READ IN INFOR TABLE
TEP A0,(BIT(30)) ANY MORE ?
J RDI YES. KEEP ON READING IT
iall$ contgy,'IOPR','IGDM','ERR$'[autodump->',''IABT'''];
[(II=0)->',''IINT''']
JDEM DEMHED PRINT DEMAND HEADER ?
quarterword turn on quarter word mode
r$dita . fire up the editor
a$qmsg HEAD1 NO. START BATCH HEADER
a$TIME1 TDATE EDIT TIME
a$qmsr . COPY UP TO DATE LOCATION
a$dayw TDATE PUT IN DAY
a$fchr ',' ...A COMMA
a$skip 1 ...A SPACE
a$DAY3 TDATE EDIT THE MONTH, DAY AND YEAR
a$qmsr . COPY REST OF THIS LINE
a$fd3 (LEVEL) EDIT THE LEVEL
r$prtxa 1 print the header line
thirdword . go back to third word mode
PRINT$ ,,1 SKIP A LINE
.
bonk .
if ii
name$ '!!' name ourselves to synchronise
sa a0,a5 save our short-lived name
fork$ iient create the II$ process
dact$ . wait for it to start breathing
endf
FORK CMDSCAN FIRE UP THE COMMAND SCANNER
FORK DISPI FIRE UP THE DISPATCHER
FORK VULCH FIRE UP THE VULTURE
AWAY EXIT$ . END OF THE LINE FOR UNNAMED ACTIVITY
.
. THIS ACTIVITY WAITS FOR COMPLETION OF PROCESSING
.
VULCH .
P ENDLESS WAIT FOR COMPLETION
P ENDLESS WAIT FOR DISPATCHER
if ii
la a0,iiname load the II$ process name
sz iiname flag him in termination
act$ . activate to close out
endf
quarterword turn on quarter word mode
r$dita . fire up the editor
ON jwsite
LA A0,BSTATW+1 LOAD NUMBER OF BREL CALLS
AA,U A0,2 INCREMENT BY ALLOWED OUTSTANDING BUFFERS
TG A0,BSTATW WERE ANY BUFFERS LOST ?
J BGETOK YES. ONLY THIS ACTSWL IS ALLOCATED
SNONZ BTRACE LOG RELEASES FROM HERE ON IN
a$qmsg BGEM START EDITING STATISTICS
a$DECV BSTATW EDIT BGET CALLS
a$qmsr . COPY BREL NUMBER HEADER
a$DECV BSTATW+1 EDIT NUMBER OF BREL CALLS
a$qmsr . EDIT HEADER FOR INUSE
a$DECV BSTATW+2,,H1 EDIT WORDS IN USE
a$qmsr . COPY REST OF DIAGNOSTIC
BGETOK .
OFF jwsite
a$qmsg ENDMSG EDIT TERMINATION MESSAGE
JDEM PRTTRM PRINT IT IF DEMAND
a$qmsg CPUMSG EDIT BATCH STATISTICS MESSAGE
GETTIME ENDTIME GET END OF EXECUTION TIME
LA A0,ENDTIME LOAD ENDING TIME
ANA A0,STARTTIME COMPUTE EXECTION TIME
SA A0,STARTTIME SAVE IT
LA,U A1 CLEAR A1
DSL A0,35 MOVE A0 TO A1, CONVERT TO 10000'THS
DI,U A0,10000 A0 = SECONDS, A1 = FRACTION
sa a1,a4 save the fraction from adit$
a$DECV . EDIT SECONDS
a$fchr '.' EDIT A PERIOD
LA A0,A4 LOAD TEN THOUSANDTHS
a$decz 4 EDIT FOUR DIGITS, ZERO FILLED
a$qmsr . COPY REST OF TIME
ON DEBUG
a$qmsr . COPY MORE OF MESSAGE
LNA,XH2 A0,BSTATW+2 LOAD MAXIMUM WORDS USED
a$DECV . EDIT INTO THE MESSAGE
a$qmsr . COPY REST OF IT
OFF DEBUG
a$fchr '.' EDIT A PERIOD
r$prtxa 2 print the ending message
EXIT . ALL DONE
.
PRTTRM r$prtxa 1 print the demand signoff message
EXIT . TERMINATE THIS LAST ACTIVITY
.
. DEMAND HEADING GENERATOR
.
DEMHED F$FD3 ('FANG ') EDIT PROCESSOR NAME
F$FD1 (LEVEL) EDIT LEVEL
F$CHAR '-' EDIT DELIMITER
F$DAY1 TDATE EDIT DATE
F$SKIP -3 BACK UP
F$CHAR '-' EDIT SEPARATOR
F$TIME TDATE EDIT TIME
F$SKIP -3 BACK UP ON IT
F$FD3 (' ') OBSCURE SECONDS IN SIGN ON TIME
F$PRT 1 PRINT THE LINE
J BONK JOIN PROCESSING
.
. This process services asynchronous interrupts from the
. interactive terminal and (unfortunately) the operator's console.
.
if ii
iient name$ 'II$' give ourselves distinctive name
sa a0,iiname save for termination activation
act$ a5 fire up initialisation process
lr,u r1,1 load nonzero in minor register
iinext ii$ . wait for next interrupt
tnz iiname are we terminating ?
exit$ . yes. exit immediately
and a0,(iismsk) mask off the value returned
tne a1,(iismsk**iisentl) is it demand interrupt value ?
sr r1,shadup yes. set output suppress flag
j iinext return for next interrupt
endf
.
. GENERAL CONTINGENCY
.
. INSURES THAT STATUS IS STORED FOR I/O ERRORS
. RATHER THAN ACTIVITY TERMINATION OCCURING.
.
IMPURE CODE
CONTGY RES 2 CONTINGENCY STATUS WORDS
TS CLOCK LOCK CONTINGENCY PROCESSING
SA A0,GCS1 SAVE A0
lxi,u a0,fang$ load our ibank
lij a0,ibcon ENTER IBANK CONTINGENCY ROUTINE
PURE CODE
ibcon sa a0,cgybdi save bdi we errored in
ON JWSITE
SNAP$P CONSNP SNAP ALL CONTINGENCY ENTRANCES
OFF JWSITE
LA,S3 A0,CONTGY LOAD CONTINGENCY TYPE
if ii=0
TNE,U A0,010 REMOTE BREAK OR II ?
J DINTR YES. PROCESS INTERRUPT
endf
ON AUTODUMP
TNE,U A0,7 ABORT$ CONTINGENCY
J ROUND2 YES. TAKE AUTOMATIC DUMP
OFF AUTODUMP
TE,U A0,012 IS CONTINGENCY ERROR MODE TYPE ?
J NOTIO NO. CAN'T BE AN I/O CONTINGENCY
LA,H1 A0,CONTGY LOAD CONTINGENCY STATUS
.
. The following code detects the ER out of range error that
. results from doing an ER TLBL$ in a system that does not
. support it. If this happens, we set a status code in the
. requesting process's A0 of 0400077. This status causes
. the requesting code to consider the tape unlabeled.
.
te,u a0,040312 is the error an unknown ER ?
j cgyneru no. test for other cases
la,h2 a0,contgy yes. load address of ER
la,h2 a0,,a0 load the ER code from instruction
te,u a0,TLBL$ is it TLBL$ ?
j notio no. this is a serious error
la,u a0,0400077 yes. load pseudo-status for request
sa,h1 a0,gcs1 plug in to return to requestor
j rezzr go return to user
.
cgyneru TNE,U A0,024112 MAX PAGES ?
J PAGLIM YES. KILL THE RUN
LA,S1 A0,CONTGY LOAD ERROR TYPE
TE,U A0,1 BETTER BE I/O !
J NOTIO NO. SET UP TO WIPE OUT
REZZR LA,H2 A0,CONTGY LOAD RE-ENTRY ADDRESS
.
. The following code, which is turned on only if remote break
. processing is via contingency instead of II$ (II=0), detects
. when a process that was waiting on a DACT$ was 'sprung' off
. it by the interrupt. Naturally, Univac does not back up the
. re-entry address to the DACT$ when this happens, so we must
. test for each DACT$ in the program and do it ourselves.
.
if ii=0
ON TSQ=0
TE,U A0,SCHDACT IS THE DACT$ IN THE SCHEDULER
OFF TSQ=0
TNE,U A0,POSDACT IS THE DACT$ IN POSITION ?
ANA,U A0,1 YES. BACK UP RETURN ADDRESS
endf
AA,U A0,1 RETURN TO NEXT INSTRUCTION
SA,H2 A0,CONTGY STORE RETURN ADDRESS IN PACKET
la a0,cgybdi reload bank error occurred in
j cgyret go to dbank in order to return
.
impure code
cgyret lij a0,$+1 switch back to bank of error
LA A0,GCS1 RELOAD USER'S A0
CTS CLOCK UNLOCK CONTINGENCY CRITICAL SECTION
ON 1 CRTN$ DOESN'T WORK !
CEND$ . TERMINATE CONTINGENCY MODE
SZ,S3 CONTGY CLEAR INDEX REGISTER FIELD IN PACKET
J *CONTGY JUMP INDIRECT THROUGH CONTINGENCY PACKET
OFF
pure code
ON 0 CRTN$ DOESN'T WORK !
CRTN$ . CLEAR CONTINGENCY MODE AND RETURN
OFF EX8LEV>30
.
NOTIO IALL$ 0 CLEAR PROGRAM CONTINGENCY
ON AUTODUMP
IALL$ CONTGY,BIT(6) SET ABORT$ CONTINGENCY
OFF AUTODUMP
PRINT$ CONTM,CONTL PRINT CONTINGENCY MESSAGE
SNAP$P CONSNP DUMP THE CONTINGENCY WORDS
LA A0,GCS1 LOAD ORIGINAL A0 CONTENTS
EABT$ . BRING THINGS TO A SCREECHING HALT
.
if ii=0
DINTR LA,S1 A0,CONTGY LOAD ERROR TYPE
TE,U A0,2 IS IT REMOTE BREAK ?
J REZZR NO. IGNORE ONSITE 'II' KEYIN
SNONZ SHADUP SET SHUT UP FLAG
J REZZR RETURN TO INTERRUPTED CODE
endf
.
PAGLIM PRINT$ PAGLMS,PAGLML,2 PRINT ERROR MESSAGE
ON AUTODUMP
IALL$ 0 CLEAR ALL CONTINGENCIES
OFF AUTODUMP
ABORT$ . TERMINATE THE PROCESSOR
.
. RECOVERY AFTER FANG INTERNAL ERROR
.
ON AUTODUMP
ROUND2 JDEM AWAY TERMINATE IF CALLED FROM DEMAND
IALL$ 0 CLEAR ALL CONTINGENCIES
PRTCN$ FERRH,FERRHL PUT HEADING ON THE DUMP
CSF$ ERFASG ASSIGN THE ERROR FILE
JN A0,FBORT ABORT IF CAN'T ASSIGN THE FILE
IOW$ WSDFF WRITE SDF ADD FILE TO TEM FILE
TZ WSDFF+IOSTATUS NORMAL COMPLETION ?
J FBORT NO. ERROR OFF
CSF$ ERFADD ADD A PMD CARD AFTER EXECUTION
FBORT ERR$ . TERMINATE IN ERROR
OFF AUTODUMP
.
PURE DATA
ascii
head1 'Processed at & on & by Marinchip Systems FANG processor level &'
endmsg 'End FANG.&'
cpumsg ' Time: & seconds& Memory: & words&'
ON jwsite
bgem 'Lions: & Christians: & Inuse: &. &'
OFF jwsite
fieldata
IMPURE DATA
CONSNP SNAP$PKT CONTGY,2 DUMP CONTINGENCY WORDS
CONTM '2 4 6 8, YOU MADE FANG DISINTEGRATE:'
CONTL EQU $-CONTM
PAGLMS '****** PAGE LIMIT WAS EXCEEDED ******'
PAGLML EQU $-PAGLMS
ON AUTODUMP
ERFASG '@ASG,T FANG$DUMP$.,F/1 . '
ERFADD '@ADD FANG$DUMP$. . '
WSDFF IO$PKT,W$ 'FANG$DUMP$' SDFTEXTL,SDFTEXT 0
.
SDFTEXT * 0500130,0 LABEL CONTROL WORD
'*SDFF*' LABEL IMAGE
* 000200,0 TEXT CONTROL WORD
'@PMD,APPLE' PMD CALL CARD
* 0777700,0 END OF FILE CONTROL WORD
SDFTEXTL EQU $-SDFTEXT
.
FERRH 'H,,,*FANG ERROR* SEND TO FANG CENTRAL, 16 ST JUDE RD, MILL ';
'VALLEY CA 94941'
FERRHL EQU $-FERRH
OFF AUTODUMP
DEMAND* * 0 DEMAND FLAG
uactn* * 0 unique activity name generator cell
errpkt* * bit(35) errpr$ packet to edit facility errors
* 0
CSFSTBIT* * 0 STATUS FROM LAST CSF$ REQUEST
SHADUP* * 0 NON-ZERO TO SUPPRESS OUTPUT
if ii
iiname * 0 II$ process name
endf
PARTBL* * 0 OPTION BITS
ENDTIME * 0 END TIME
GCS1 * 0 CONTINGENCY A0 SAVE
cgybdi * 0 save for bdi of error
CLOCK * 0 CONTINGENCY LOCK
STARTTIME * 0 EXECUTION START TIME
ENDLESS* PVQUEUE 0 COMPLETION QUEUE
END