mirror of
https://github.com/PDP-10/its.git
synced 2026-04-01 20:08:07 +00:00
628a20654b
Patch out the call to FIXIFY in CC. This subroutine uses the UFA instruction which isn't implemented on a KS10. Make the use of UFA an assembly time conditional in the C library. Replace it with FIX on KS10.
439 lines
8.4 KiB
Plaintext
439 lines
8.4 KiB
Plaintext
;
|
||
; C10RUN - BASIC C RUN-TIME SUPPORT
|
||
;
|
||
; This file is ITS dependent.
|
||
;
|
||
|
||
TITLE CRUN
|
||
.INSRT NC
|
||
.INSRT NM
|
||
|
||
IFNDEF KS10,KS10==0
|
||
|
||
.GLOBAL A,B,C,D,P,GO,.CCALL,.VCALL,.ACALL,.XCALL
|
||
|
||
PDLSIZ==20000 ; DESIRED PDL SIZE
|
||
MAXARG==40. ; MAXIMUM NUMBER OF ARGUMENTS
|
||
BUFSZ==250. ; COMMAND BUFFER SIZE IN CHARACTERS
|
||
TP==16
|
||
|
||
;
|
||
; START-UP ROUTINE
|
||
;
|
||
|
||
IENTRY START
|
||
|
||
; ENABLE INTERRUPTS
|
||
|
||
.SUSET [.ROPTI,,A] ; READ OPTION WORD
|
||
TLO A,OPTOPC+OPTINT ; SET OLD PC ON MPV, IOC AND
|
||
; USE NEW INTERRUPT STACKING SCHEME
|
||
.SUSET [.SOPTI,,A] ; SET OPTION WORD
|
||
|
||
MOVE A,[-TSINTL",,TSINT"] ; SET UP INTERRUPT HANDLING
|
||
MOVEM A,42
|
||
MOVEI A,%PIMPV+%PIPDL ; ENABLE MPV AND PDL OVERFLOW
|
||
.SUSET [.SMASK,,A]
|
||
|
||
;SET UP UUO HANDLER
|
||
|
||
MOVE A,[JSR UUOH"]
|
||
MOVEM A,41
|
||
|
||
MOVE P,PDLBOT ; STACK
|
||
MOVE TP,TPINIT ; TIME STACK (IF IN TIMING MODE)
|
||
MCALL $SETUP
|
||
IENTRY RESTART
|
||
MOVE P,PDLBOT
|
||
VCALL @CALLER,[ARGC,[[ARGV]]]
|
||
CALL CEXIT,[[[0]]]
|
||
IENTRY .EXIT
|
||
SETZM TIMING
|
||
SKIPE EXITER
|
||
VCALL @EXITER ; CLEAN-UP TIMING
|
||
.LOGOUT ; IN CASE WE ARE AT TOP LEVEL
|
||
.BREAK 16,160000 ; COMMIT SUICIDE
|
||
|
||
; SETUP ROUTINE
|
||
|
||
; TURN OFF TTY ECHOING, READ AND PARSE JCL COMMAND,
|
||
; GET JOB NAME, INITIALIZE I/O, OPEN TTY
|
||
|
||
MENTRY $SETUP
|
||
|
||
; TURN OFF TTY ECHOING
|
||
|
||
.SUSET [.RTTY,,A] ; READ TTY WORD
|
||
TLNE A,400000 ; TEST %TBNOT BIT
|
||
GO SET$0 ; DONT HAVE TTY
|
||
.OPEN 17,[SIXBIT/ TTY/]
|
||
GO SET$0 ; WHO CARES IF IT FAILS
|
||
.CALL [SETZ ; TURN OFF ECHOING
|
||
'TTYSET
|
||
1000,,17
|
||
[020202020202]
|
||
SETZ [030202020202]
|
||
]
|
||
JFCL
|
||
.CLOSE 17,
|
||
|
||
SET$0: .CLOSE 1, ; HACK FOR TOP-LEVEL BOOTSTRAP
|
||
.CLOSE 2,
|
||
.CLOSE 3,
|
||
|
||
; READ JCL
|
||
|
||
.SUSET [.ROPTI,,A] ; READ OPTION WORD
|
||
TLNN A,OPTCMD ; IS THERE SOME JCL
|
||
GO SET$2 ; NOPE
|
||
|
||
SETZM JCLBUF ; FIRST WORD -- MAKE SURE ITS THERE
|
||
SETOM JCLBUF+<BUFSZ/5>-1 ; LAST WORD OF JCLBUF
|
||
.BREAK 12,[..RJCL,,JCLBUF] ; READ JCL
|
||
|
||
; READ JOB NAME
|
||
|
||
SET$2: .SUSET [.RXJNAME,,XJNAME]
|
||
|
||
; PARSE JCL
|
||
|
||
MCALL PRSARG,[[[440700,,JCLBUF]],[[ARGBUF]],[[ARGV]],XJNAME,[[MAXARG]]]
|
||
MOVEM A,ARGC
|
||
|
||
CALL C0INIT ; INITIALIZE C I/O ROUTINES
|
||
CALL FXARG,[ARGC,[[ARGV]]] ; DO REDIRECTION OF STANDARD I/O
|
||
MOVEM A,ARGC
|
||
|
||
.SUSET [.RTTY,,A] ; READ TTY WORD
|
||
TLNE A,400000 ; TEST %TBNOT BIT
|
||
GO SET$R ; RETURN IF DONT HAVE TTY
|
||
CALL TYIOPN ; ENABLE INTERRUPT CHARS
|
||
SET$R: RETURN
|
||
|
||
IENTRY STKDMP
|
||
|
||
PUSH P,0 ; SAVE REGISTERS
|
||
PUSH P,A
|
||
PUSH P,B
|
||
PUSH P,C
|
||
PUSH P,D
|
||
PUSH P,[0] ; PLACE TO SAVE 'REAL' RETURN ADDRESS
|
||
PUSH P,[0] ; ZERO ARG TO STKDMP
|
||
.VALUE [ASCIZ\..XECP/0/1Q
|
||
P\]
|
||
MOVEM 0,-1(P) ; SAVE AWAY 'REAL' RETURN ADDRESS
|
||
PUSHJ P,ZSTKDMP"
|
||
POP P,(P)
|
||
POP P,D
|
||
POP P,C
|
||
POP P,B
|
||
POP P,A
|
||
POP P,0
|
||
POPJ P,
|
||
|
||
;
|
||
; EXIT ROUTINES
|
||
;
|
||
|
||
CENTRY CEXIT,[CC]
|
||
CALL CLOSALL
|
||
MOVE A,CC
|
||
GO .EXIT
|
||
|
||
CENTRY CQUIT,[CC]
|
||
CROAK CQUIT CALLED
|
||
CALL CEXIT,[CC]
|
||
|
||
|
||
; CODE TO PERFORM LOAD-TIME INITIALIZATION
|
||
; FLUSHES ZERO PAGES IN IMPURE AREAS
|
||
|
||
.IDATA
|
||
; NO LITERALS IN THIS CODE!
|
||
|
||
IENTRY LBINIT ; INIT FOR MAKING LIBRARY
|
||
SETZM IFLUSH ; DON'T FLUSH ZERO-PAGES BECAUSE
|
||
; MAKLIB EXPECTS THEM TO BE THERE
|
||
MOVE A,LBD1 ; RESET FLUSH-FLAG WHEN DONE
|
||
MOVEM A,IDONE
|
||
GO LINIT
|
||
LBD1: SETOM IFLUSH
|
||
|
||
IENTRY LINIT
|
||
|
||
MOVEI P,ARGV ; TEMPORARY PDL
|
||
|
||
IENTRY ISTART
|
||
|
||
JFCL
|
||
|
||
; SETUP SEGMENT BOUNDARIES
|
||
|
||
HLRZ A,20
|
||
MOVEM A,SEG0LO
|
||
HRRZ A,20
|
||
MOVEM A,SEG0HI
|
||
SETZM 20
|
||
HLRZ A,21
|
||
MOVEM A,SEG1LO
|
||
HRRZ A,21
|
||
MOVEM A,SEG1HI
|
||
SETZM 21
|
||
HLRZ A,22
|
||
MOVEM A,SEG2LO
|
||
HRRZ A,22
|
||
MOVEM A,SEG2HI
|
||
SETZM 22
|
||
HLRZ A,23
|
||
MOVEM A,SEG3LO
|
||
HRRZ A,23
|
||
MOVEM A,SEG3HI
|
||
SETZM 23
|
||
|
||
; INITIALIZE PAGE-TABLE
|
||
|
||
MOVEI A,256.
|
||
I$LOOP: SOJL A,I$SMSH ; A IS PAGE NUMBER
|
||
.CALL I$CORT ; GET PAGE INFO
|
||
.VALUE I$MES1 ; SYSTEM CALL LOST
|
||
MOVEM B,PAGTAB(A)
|
||
GO I$LOOP
|
||
|
||
; NOW LOOK FOR .CCALLS TO SMASH
|
||
|
||
I$SMSH: SKIPE TIMING ; DON'T SMASH IF TIMING
|
||
GO I$FLSH
|
||
SKIPA A,SEG2LO ; POINTER TO BEGINNING OF CODE AREA
|
||
I$S1: ADDI A,1 ; NEXT WORD
|
||
CAML A,SEG2HI ; AT END OF CODE AREA?
|
||
GO I$PURE ; DONE
|
||
HLRZ B,(A) ; INSTRUCTION
|
||
TRZ B,000777 ; ISOLATE OPCODE
|
||
CAIE B,(.CCALL) ; IS IT A .CCALL?
|
||
GO I$S1 ; NO, GO ON
|
||
HLRZ B,(A) ; THE INSTRUCTION AGAIN
|
||
TRNN B,000037 ; IS INDEXING OR INDIRECTION USED
|
||
GO I$S6 ; NO, IT'S A CONSTANT CALL
|
||
TRZ B,777000 ; SMASH OPCODE
|
||
IORI B,(.VCALL) ; MAKE IT A .VCALL
|
||
HRLM B,(A) ; SMASH THE .CCALL
|
||
GO I$S1 ; GO ON TO NEXT WORD
|
||
|
||
I$S6: HRRZ C,(A) ; THE CALLED PROCEDURE
|
||
JUMPE C,I$S1 ; NO SUCH PROCEDURE
|
||
HLRZ 0,-1(C) ; THE NUMBER OF FORMAL ARGS
|
||
CAIL 0,20 ; REASONABLE NUMBER?
|
||
GO I$S1 ; NO, NOT A PROCEDURE
|
||
LDB B,[270400,,(A)] ; THE NUMBER OF ACTUAL ARGS
|
||
CAIE 0,(B) ; DO THE NUMBERS MATCH?
|
||
GO I$S2 ; NO
|
||
MOVEI B,(PUSHJ P,)
|
||
HRLM B,(A) ; SMASH .CCALL TO PUSHJ
|
||
GO I$S1
|
||
|
||
; HERE IF NUMBER OF ACTUALS AND FORMALS ARE DIFFERENT
|
||
|
||
I$S2: SUBI 0,(B) ; NUMBER OF EXTRA ACTUALS NEEDED
|
||
JUMPL 0,I$S5 ; TOO MANY ACTUALS GIVEN
|
||
MOVE B,0
|
||
ADDI B,2
|
||
CL I$ALLC ; ALLOCATE SPACE FOR PROG
|
||
HRRZ B,D ; ADDRESS OF BLOCK
|
||
HRLI B,(JSP D,) ; CONSTRUCT CALL TO IT
|
||
MOVEM B,(A) ; SMASH ORIGINAL CALL
|
||
SUBI D,1
|
||
I$S3: SOJL 0,I$S4 ; FOR EACH MISSING ARG
|
||
PUSH D,PZERO ; COMPILE A PUSH OF ZERO
|
||
GO I$S3
|
||
I$S4: PUSH D,PUSHD ; COMPILE A PUSH OF D (RETURN ADDRESS)
|
||
HRLI C,(GO) ; MAKE JUMP TO CALLED PROC
|
||
PUSH D,C ; COMPILE CALL
|
||
GO I$S1 ; FINISHED WITH THIS CALL
|
||
|
||
; HERE IF NUMBER OF ACTUALS EXCEEDS NUMBER OF FORMALS
|
||
|
||
I$S5: MOVEI B,3 ; GET TWO WORDS
|
||
CL I$ALLC
|
||
HRRZ B,D ; ADDRESS OF BLOCK
|
||
HRLI B,(JSP D,) ; MAKE CALL TO IT
|
||
MOVEM B,(A) ; SMASH ORIGINAL CALL
|
||
MOVN B,0 ; NUMBER OF EXTRA ARGS
|
||
HRLI B,(SUBI P,) ; CONSTRUCT INSTRUCTION
|
||
MOVEM B,(D) ; STORE IN BLOCK
|
||
MOVE B,PUSHD
|
||
MOVEM B,1(D)
|
||
HRLI C,(GO) ; MAKE JUMP TO CALLED PROC
|
||
MOVEM C,2(D) ; STORE IN BLOCK
|
||
GO I$S1 ; FINISHED WITH THIS CALL
|
||
|
||
; NOW PURIFY HIGH SEGMENTS
|
||
|
||
I$PURE: MOVE A,SEG2LO
|
||
TRZ A,1777
|
||
MOVE B,SEG2HI
|
||
SUBI B,(A)
|
||
LSH A,-10.
|
||
ADDI B,1777
|
||
LSH B,-10.
|
||
MOVN B,B
|
||
HRL A,B
|
||
.CALL I$PBLK
|
||
.VALUE I$MES4
|
||
MOVE A,SEG3LO
|
||
TRZ A,1777
|
||
MOVE B,SEG3HI
|
||
SUBI B,(A)
|
||
LSH A,-10.
|
||
ADDI B,1777
|
||
LSH B,-10.
|
||
MOVN B,B
|
||
HRL A,B
|
||
.CALL I$PBLK
|
||
.VALUE I$MES4
|
||
|
||
; NOW LOOK FOR ZERO-PAGES TO FLUSH
|
||
|
||
I$FLSH: SKIPN IFLUSH
|
||
GO I$DONE
|
||
MOVEI A,0 ; FIRST PAGE IS 1 (CAN'T FLUSH 0!)
|
||
NXTPAG: ADDI A,1 ; CURRENT PAGE NUMBER
|
||
MOVE B,A
|
||
LSH B,10. ; POINTER TO FIRST WORD IN PAGE
|
||
CAMLE B,SEG1HI ; STILL IN IMPURE AREA?
|
||
GO I$DONE ; NO, DONE
|
||
SKIPN PAGTAB(A) ; DOES PAGE EXIST?
|
||
GO NXTPAG ; NO, TRY NEXT ONE
|
||
NXTWRD: SKIPE (B) ; IS THE WORD ZERO
|
||
GO NXTPAG ; NO, CAN'T FLUSH THIS PAGE
|
||
ADDI B,1 ; NEXT WORD
|
||
TRNE B,1777 ; IN NEXT PAGE?
|
||
GO NXTWRD ; NO, KEEP GOING
|
||
.CALL I$CORB ; YES, DELETE PAGE
|
||
.VALUE I$MES2 ; SYSTEM CALL LOST
|
||
GO NXTPAG ; GO ON TO NEXT PAGE
|
||
|
||
I$DONE:
|
||
|
||
IENTRY IDONE
|
||
|
||
JFCL
|
||
SETZ A, ; CLEAN UP
|
||
SETZ B, ; LIKE A GOOD BOY SHOULD
|
||
SETZ C,
|
||
SETZ D,
|
||
.BREAK 16,0 ; RETURN TO LOADER
|
||
|
||
; STORAGE ALLOCATOR FOR .CCALL COMPILER
|
||
; CALL WITH SIZE IN B
|
||
; RETURNS ADDRESS IN D
|
||
|
||
I$ALLC: MOVE D,SEG3HI ; TOP OF PATCH SPACE
|
||
ADDI D,1 ; POINT TO NEW BLOCK
|
||
ADDB B,SEG3HI ; NEW TOP OF PATCH SPACE
|
||
LSH B,-10. ; PAGE OF TOP OF PATCH SPACE
|
||
SKIPE PAGTAB(B) ; DOES PAGE EXIST?
|
||
RTN ; YES
|
||
.CALL I$GETB ; GET PAGE
|
||
.VALUE I$MES3 ; SYSTEM CALL LOST
|
||
SETOM PAGTAB(B) ; UPDATE PAGE TABLE
|
||
RTN ; RETURN
|
||
|
||
MDATA TIMING
|
||
0
|
||
|
||
IFLUSH: -1 ; FLUSH ZERO PAGES
|
||
I$CORT: SETZ ? 'CORTYP ? A ? 402000,,B
|
||
I$CORB: SETZ ? 'CORBLK ? 1000,,0 ? 1000,,%JSELF ? SETZ A
|
||
I$PBLK: SETZ ? 'CORBLK ? 1000,,%CBNDR ? 1000,,%JSELF ? 400000,,A
|
||
I$GETB: SETZ ? 'CORBLK ? 1000,,%CBNDR+%CBNDW ? 1000,,%JSELF ?
|
||
B ? 401000,,%JSNEW
|
||
I$MES1: ASCIZ/CORTYP FAILED/
|
||
I$MES2: ASCIZ/PAGE-DELETE FAILED/
|
||
I$MES3: ASCIZ/PAGE-GET FAILED/
|
||
I$MES4: ASCIZ/PURIFY FAILED/
|
||
|
||
.CODE
|
||
|
||
IFE KS10,[
|
||
EXPUNGE FIX
|
||
DEFINE FIX X,Y
|
||
UFA Y,[233000000000']
|
||
TLZ X,777000'
|
||
TERMIN
|
||
]
|
||
|
||
IENTRY FIXIFY
|
||
|
||
JUMPL A,FIXL
|
||
FADR A,[.499999]
|
||
FIX B,A
|
||
JRST @0
|
||
FIXL: MOVN A,A
|
||
FADR A,[.499999]
|
||
FIX B,A
|
||
MOVN B,B
|
||
JRST @0
|
||
|
||
; IMPURE AREA
|
||
|
||
.IDATA
|
||
-1 ; THIS STUFF MUST NOT BE FLUSHED!
|
||
MDATA PAGTAB ; PAGE TABLE
|
||
BLOCK 256.
|
||
MDATA ARGV
|
||
BLOCK MAXARG ; POINTERS TO ARGS PLACED HERE
|
||
MDATA XJNAME
|
||
BLOCK 1 ; JOB NAME
|
||
MDATA SEG0LO
|
||
0
|
||
MDATA SEG0HI
|
||
0
|
||
MDATA SEG1LO
|
||
0
|
||
MDATA SEG1HI
|
||
0
|
||
MDATA SEG2LO
|
||
0
|
||
MDATA SEG2HI
|
||
0
|
||
MDATA SEG3LO
|
||
0
|
||
MDATA SEG3HI
|
||
0
|
||
; END OF WIRED-DOWN STUFF (PROTECTED
|
||
; ON THIS END BY CALLER)
|
||
MDATA CALLER
|
||
ZMAIN" ; C ROUTINE CALLED AS PROGRAM
|
||
MDATA PURBOT
|
||
0
|
||
MDATA PURTOP
|
||
0
|
||
|
||
.UDATA
|
||
MDATA EXITER
|
||
BLOCK 1 ; EXIT ROUTINE (FOR TIMING)
|
||
ARGC: BLOCK 1 ; NUMBER OF ARGUMENTS TO MAIN
|
||
JCLBUF: BLOCK BUFSZ/5 ; JCL BUFFER
|
||
ARGBUF: BLOCK BUFSZ ; MAIN ARGS BUFFER
|
||
PDL: BLOCK PDLSIZ ; THE STACK
|
||
.IDATA
|
||
MDATA PDLBOT
|
||
PDL
|
||
MDATA PDLTOP
|
||
PDL+PDLSIZ-1
|
||
.PDATA
|
||
MDATA PZERO
|
||
PUSH P,ZERO
|
||
MDATA ZERO
|
||
0
|
||
MDATA PUSHD
|
||
PUSH P,D
|
||
MDATA TPINIT ; SET BY TINIT
|
||
0
|
||
|
||
CONSTANTS
|
||
|
||
MDATA PATCH
|
||
|
||
END START
|