github.com/PDP-10.its
1
0
Fork 0
mirror of https://github.com/PDP-10/its.git synced 2026-01-27 12:42:10 +00:00
Code Issues Releases Wiki Activity

Files from CLIB; AR2 CLIB.

Browse Source
This commit is contained in:
Lars Brinkhoff
2018-10-18 15:04:18 +02:00
parent b1fd5187cc
commit 2bb4e1d28a
58 changed files with 8861 additions and 1 deletions
Download Patch File Download Diff File Expand all files Collapse all files

35
src/c/code.insert Normal file
View File

@@ -0,0 +1,35 @@
; MACROS FOR SEPARATE CODE LITERAL AREA
; THIS DOES NOT HANDLE RECURSIVE CALLS
CD%N==0
IF1,[CD%LOC==0]
DEFINE CD%AS *PREFIX*,#SEGNO,*SUFFIX*
PREFIX!SEGNO!SUFFIX
TERMIN
DEFINE CODE BODY
IF2,[ CD%AS/CD%LOC+CD%/,CD%N+1]
CD%N==CD%N+1
DOT==.-1
CD%OLC==.
IF1,[
BODY
CD%AS /CD%/,CD%N,/==CD%LOC/
CD%LOC==CD%LOC+<.-CD%OLC>
]
IF2,[
CD%AS /LOC CD%LOC+CD%/,CD%N
BODY
]
LOC CD%OLC
TERMIN
DEFINE INSCODE
IF1,[
CD%SIZ==CD%LOC
CD%LOC==.
BLOCK CD%SIZ
]
TERMIN

163
src/c/nm.insert Normal file
View File

@@ -0,0 +1,163 @@
.INSRT C;CODE INSERT
.OFNM2=SIXBIT/STK/
CL=PUSHJ P,
RTN=POPJ P,
.VCALL=2_33
.ACALL=3_33
.XCALL=4_33
DEFINE SYSCAL NAME,ARGS,DUMMY,LABEL
SETZ A,
.CALL [SETZ
.1STWD SIXBIT /NAME/
ARGS
403000,,A
]
IFSN [LABEL][]GO LABEL
IFSE [LABEL][]MOVN A,A
TERMIN
DEFINE INFORM A,B
IF1,[PRINTX \ A = B
\]
TERMIN
; SUPPORT ROUTINES
DEFINE %LEN [LIST]
%COUNT==0
IRP ELEM,,LIST
%COUNT==%COUNT+1
TERMIN
TERMIN
DEFINE DEFVAR NAME,#OFFSET
DEFINE NAME
<OFFSET-%P>&262143.(P)TERMIN
TERMIN
; DEFINE C-CALLABLE PROCEDURE (C NAME)
DEFINE CENTRY NAME,[ARGS],[VARS]
PROLOG Z!NAME,NAME,ARGS,VARS
TERMIN
; DEFINE C-CALLABLE PROCEDURE (MIDAS NAME)
DEFINE MENTRY NAME,[ARGS],[VARS]
PROLOG NAME,NAME,ARGS,VARS
TERMIN
; DEFINE MIDAS ENTRY POINT (NOT PROCEDURE)
DEFINE IENTRY NAME
NAME": TERMIN
; PROLOG MACRO
DEFINE PROLOG MNAME,PNAME,[ARGS],[VARS]
%LEN ARGS
%A==%COUNT
%LEN VARS
%V==%COUNT
%OFF== -<%A+%V>
IRP ARGNAM,,ARGS
DEFVAR ARGNAM,%OFF
%OFF==%OFF+1
TERMIN
%OFF==%OFF+1
IRP VARNAM,,VARS
DEFVAR VARNAM,%OFF
%OFF==%OFF+1
TERMIN
%A,,[ASCIZ/PNAME/]
MNAME": IFN %V,[ADDI P,%V]
TERMIN
; DEFINE SYNONYM FOR C-CALLABLE ENTRY POINT
DEFINE XENTRY NEWNAME,OLDNAME
Z!NEWNAME"=Z!OLDNAME"
TERMIN
; DEFINE MIDAS-ACCESSIBLE DATA
DEFINE MDATA NAME
NAME":TERMIN
; FATAL ERROR
DEFINE CROAK STRING/
.VALUE [ASCIZ \
: STRING 
\]
TERMIN
; RETURN STATEMENT
DEFINE RETURN
IFE %A,[
IFN %V,[SUBI P,%V]
POPJ P,
]
IFN %A,[
SUBI P,%V+%A+1
JRST @<%A+1>(P)
]
TERMIN
; CALL STATEMENT
DEFINE CALL NAME,[ARGS]
NN==0
IRP ARG,,ARGS
PPUSH ARG
NN==NN+1
TERMIN
ICALL NN,NAME
TERMIN
; MIDAS-CALL STATEMENT
DEFINE MCALL NAME,[ARGS]
NN==0
IRP ARG,,ARGS
PPUSH ARG
NN==NN+1
TERMIN
CCALL NN,NAME"
TERMIN
; VARIABLE-CALL STATEMENT
DEFINE VCALL F,[ARGS]
NN==0
IRP ARG,,ARGS
PPUSH ARG
NN==NN+1
TERMIN
CCALL NN,F
TERMIN
; INTERNAL CALL
DEFINE ICALL N,NAME
CCALL N,Z!NAME"
TERMIN
; HACK FOR CONSTANTS
EQUALS NM%EN END
EXPUNGE END
DEFINE END ENDLOC
.CODE
INSCODE
.PDATA
CONSTANTS
NM%EN ENDLOC
TERMIN
.CODE

280
src/clib/ac.c Normal file
View File

@@ -0,0 +1,280 @@
#
/*
AC - Array of Characters Cluster
operations:
ac_new () => ac create empty array
ac_alloc (size) => ac create empty array, preferred size
ac_create (string) => ac create with initial value
ac_xh (ac, c) => c extend array with character
ac_trim (ac) => ac trim excess storage
ac_fetch (ac, i) => c fetch character from array
ac_link (ac) => ac make new link to array
ac_unlink (ac) remove link to array
ac_puts (ac, f) print array
ac_cat (ac, ac) => ac concatenate arrays
ac_copy (ac) => ac copy array
ac_string (ac) => *char return string version
ac_size (ac) => size return current size of array
ac_flush (ac) make array empty
ac_n () => int return # of active arrays
*/
struct rep {
int count; /* reference count */
char *s; /* pointer to actual array */
int csize; /* logical size of array */
int msize; /* physical size of array (at least csize+1) */
};
# define ac struct rep* /* watch usage! */
# define ASIZE 4 /* number of words in rep */
# define initial_size 8 /* default initial allocation */
char *calloc ();
int *salloc ();
ac ac_new();
ac ac_alloc();
ac ac_create();
ac ac_link();
ac ac_cat();
ac ac_copy();
static int count;
/**********************************************************************
AC_NEW - Create empty array.
AC_ALLOC - Create empty array, preferred size given.
**********************************************************************/
ac ac_new ()
{return (ac_alloc (initial_size));}
ac ac_alloc (sz)
{ac a;
if (sz<0) sz=0;
a = salloc (ASIZE);
a->count = 1;
a->csize = 0;
a->msize = sz+1;
a->s = calloc (a->msize);
++count;
return (a);
}
/**********************************************************************
AC_CREATE - Create array with initial value.
**********************************************************************/
ac ac_create (s) char s[];
{register char *p;
register int sz;
register ac a;
sz = slen (s);
a = ac_alloc (sz);
a->csize = sz;
p = a->s;
while (--sz >= 0) *p++ = *s++;
return (a);
}
/**********************************************************************
AC_XH - Extend Array with Character.
**********************************************************************/
char ac_xh (a, c) register ac a;
{register char *p, *q;
char *old;
int i;
if ((i = a->csize) >= a->msize-1)
{old = p = a->s;
a->s = q = calloc (a->msize =* 2);
while (--i >= 0) *q++ = *p++;
if (old) cfree (old);
}
a->s[a->csize++] = c;
return (c);
}
/**********************************************************************
AC_TRIM - Discard excess storage.
**********************************************************************/
ac ac_trim (a) register ac a;
{register char *p, *q;
char *old;
int i;
if ((i = a->csize) < a->msize-1)
{old = p = a->s;
a->s = q = calloc (a->msize = a->csize + 1);
while (--i >= 0) *q++ = *p++;
if (old) cfree (old);
}
return (a);
}
/**********************************************************************
AC_FETCH - Fetch Character from Array.
**********************************************************************/
char ac_fetch (a, n) ac a;
{extern int cerr;
if (n<0 || n>=a->csize)
{cprint (cerr, "Character array bounds error.");
return (0);
}
return (a->s[n]);
}
/**********************************************************************
AC_LINK - Create link to array.
**********************************************************************/
ac ac_link (a) ac a;
{++a->count;
return (a);
}
/**********************************************************************
AC_UNLINK - Remove link to array.
**********************************************************************/
ac_unlink (a) ac a;
{if (--a->count == 0)
{if (a->s) cfree (a->s);
--count;
sfree (a);
}
}
/**********************************************************************
AC_PUTS - Print array.
**********************************************************************/
ac_puts (a, f, wid) ac a; /* 3 args for cprint usage */
{register char *p;
register int i;
p = a->s;
i = a->csize;
while (--i >= 0) cputc (*p++, f);
}
/**********************************************************************
AC_CAT - Concatenate arrays.
**********************************************************************/
ac ac_cat (a1, a2) ac a1; ac a2;
{register ac a;
register char *p, *q;
int i;
a = ac_alloc (i = a1->csize + a2->csize);
a->csize = i;
p = a->s;
q = a1->s;
i = a1->csize;
while (--i>=0) *p++ = *q++;
q = a2->s;
i = a2->csize;
while (--i>=0) *p++ = *q++;
return (a);
}
/**********************************************************************
AC_COPY - Copy array.
**********************************************************************/
ac ac_copy (a1) ac a1;
{register ac a;
register char *p, *q;
int i;
a = ac_alloc (i = a1->csize);
a->csize = i;
p = a->s;
q = a1->s;
while (--i >= 0) *p++ = *q++;
return (a);
}
/**********************************************************************
AC_STRING - Return string version of array. The returned
string is valid only while the array remains linked
to and unchanged.
**********************************************************************/
char *ac_string (a) ac a;
{a->s[a->csize]=0;
return (a->s);
}
/**********************************************************************
AC_SIZE - Return current size of array.
**********************************************************************/
int ac_size (a) ac a;
{return (a->csize);}
/**********************************************************************
AC_FLUSH - Make array empty
**********************************************************************/
ac_flush (a) ac a;
{a->csize = 0;}
/**********************************************************************
AC_N - Return number of active arrays.
**********************************************************************/
int ac_n () {return (count);}

224
src/clib/alloc.cmid Normal file
View File

@@ -0,0 +1,224 @@
;
; ALLOC - C FREE STORAGE ROUTINES
;
; This file is PDP-10 dependent, system independent.
;
; CALLOC (SIZE) => *CHAR ; ALLOCATE ZEROED CHARACTERS
; SALLOC (SIZE) => *INT ; ALLOCATE ZEROED WORDS
; CFREE (*CHAR) ; RETURN CHARACTERS
; SFREE (*INT) ; RETURN WORDS
;
; AFREE (SIZE) => (ADDR) ; ALLOCATE GARBAGE WORDS
; AFRET (ADDR, SIZE) ; DEALLOCATE WORDS
; AFREZ (SIZE) => (ADDR) ; ALLOCATE AND ZERO WORDS
;
; ALOCSTAT (&NWALLOC, &NBFREE) => NWFREE ; COMPUTE STATS
;
TITLE ALLOC
.INSRT NC
.INSRT NM
; THESE ARE STORAGE-ALLOCATION ROUTINES WITH SOME PROTECTION
CENTRY CALLOC,[NWORDS] ; ALLOCATE CHARACTERS
XENTRY SALLOC,CALLOC ; ALLOCATE WORDS
SKIPL A,NWORDS ; DON'T ADD TO BAD SIZE
ADDI A,2 ; FOR HEADER WORDS
CALL AFREZ,[A]
ADDI A,2 ; POINTER TO USER AREA OF BLOCK
MOVE B,NWORDS
MOVEM B,-1(A) ; STORE SIZE IN HEADER
MOVE B,A
ADD B,[147506732514]
MOVEM B,-2(A) ; MAGIC WORD IN HEADER
RETURN
CENTRY CFREE,[PTR] ; RETURN CHARACTERS
XENTRY SFREE,CFREE ; RETURN WORDS
MOVE A,PTR
MOVE B,-2(A)
SUB B,A
CAME B,[147506732514]
GO CF$BAD
MOVEI A,-2(A)
MOVE B,1(A)
ADDI B,2
CALL AFRET,[A,B]
SETZ A,
CF$RET: RETURN
CF$BAD: CROAK BAD CALL TO CFREE/SFREE
SETO A,
GO CF$RET
.IDATA
MDATA FNWORDS ; NUMBER OF WORDS ALLOCATED
0
MDATA FLIST
FLIST+1 ; LIST OF FREE BLOCKS
0
.CODE
;
; AFREE - ALLOCATE STORAGE
;
CENTRY AFREE,[BSIZE]
XENTRY GETVEC,AFREE
MOVE A,BSIZE
JUMPLE A,AE$BAD ; SIZE MUST BE POSITIVE
CAIL A,400000 ; SIZE MUST BE REASONABLE
GO AE$BAD
HRLZI D,(A) ; SIZE IN LEFT HALF FOR COMPARISON
MOVEI B,FLIST ; PREVIOUS BLOCK ADDR IN B
HRRZ C,(B) ; CURRENT BLOCK ADDR IN C
A1: CAMG D,(C) ; IS CURRENT BLOCK BIG ENOUGH?
GO A3 ; YES
MOVEI B,(C) ; CURRENT BLOCK -> PREVIOUS BLOCK
HRRZ C,(C) ; NEXT BLOCK -> CURRENT BLOCK
JUMPN C,A1 ; BLOCK EXISTS => LOOP
HLRZ B,D ; DESIRED SIZE IN B
PPUSH B ; SAVE SIZE NEEDED
CALL GETCORE,[B] ; ALLOCATE NEW BLOCK (SIZE,,ADDR)
HLRZ B,A ; SIZE OBTAINED
HRRZ A,A ; ADDRESS OF BLOCK
PPOP D ; SIZE NEEDED
SUBI B,(D) ; HOW MUCH EXTRA OBTAINED?
JUMPE B,AE$RET ; NO EXCESS => DONE
PPUSH A ; ADDRESS OF BLOCK
ADDM B,(P) ; ADDRESS OF DESIRED PART OF BLOCK
CALL AFRET,[A,B] ; RETURN THE EXCESS
PPOP A ; ADDRESS OF DESIRED PART OF BLOCK
GO AE$RET ; DONE
; HERE WHEN A SUFFICIENTLY LARGE BLOCK FOUND IN LIST
A3: HLRZ D,D ; DESIRED SIZE IN D
HLRZ A,(C) ; SIZE OF BLOCK IN LIST
SUBI A,(D) ; EXCESS
JUMPE A,A4 ; NO EXCESS => DELETE BLOCK FROM LIST
HRLM A,(C) ; NEW BLOCK SIZE
ADDI A,(C) ; ADDRESS OF DESIRED PART OF BLOCK
GO AE$RET ; DONE
; HERE WHEN ENTIRE BLOCK IS TO BE REMOVED FROM THE LIST
A4: HRRZ A,(C) ; NEXT BLOCK IN LIST
HRRM A,(B) ; CHAIN TO PREVIOUS BLOCK
MOVEI A,(C) ; RETURN THIS BLOCK
GO AE$RET ; DONE
AE$BAD: CROAK AFREE CALLED WITH BAD SIZE ARGUMENT
SETZ A,
AE$RET: RETURN ; DONE
;
; AFRET - DEALLOCATE STORAGE
;
CENTRY AFRET,[PTR,BSIZE]
MOVE A,PTR
MOVE B,BSIZE
JUMPLE B,CODE [ ; SIZE MUST BE POSITIVE
CROAK AFRET CALLED WITH BAD SIZE ARGUMENT
GO ARRET
]
MOVEI C,FLIST ; ADDRESS OF PREVIOUS BLOCK IN C
HRRZ D,(C) ; ADDRESS OF CURRENT BLOCK IN D
A5: CAIG A,(D) ; FIND PLACE IN LIST
GO A8 ; NEW BLOCK GOES HERE
MOVEI C,(D) ; CURRENT BLOCK -> PREVIOUS BLOCK
HRRZ D,(D) ; NEXT BLOCK -> CURRENT BLOCK
JUMPN D,A5 ; BLOCK EXISTS => LOOP
; HERE TO INSERT NEW BLOCK AFTER A GIVEN BLOCK IN LIST
A6: HLRZ D,(C) ; SIZE OF OLD BLOCK
ADDI D,(C) ; END OF OLD BLOCK
CAIGE A,(D) ; OVERLAP WITH PREVIOUS BLOCK ?
GO CODE [ ; YES, ERROR
CROAK AFRET CALLED WITH BAD ADDRESS
GO ARRET
]
CAIN A,(D) ; CONTIGUOUS WITH PREVIOUS BLOCK ?
GO A7 ; YES, GO MERGE THEM
HRRZ D,(C) ; ADDRESS OF NEXT BLOCK (IF ANY)
HRLI D,(B) ; SIZE OF BLOCK BEING FREED (IN LEFT HALF)
MOVEM D,(A) ; MAKE DOPE WORD OF BLOCK BEING FREED
HRRM A,(C) ; CHAIN IT TO PREVIOUS BLOCK
GO ARRET ; DONE
; HERE TO MERGE BLOCK WITH PREVIOUS BLOCK (ADDR IN C)
A7: HLRZ D,(C) ; SIZE OF OLD BLOCK
ADDI D,(B) ; ADD SIZE OF BLOCK BEING FREED
HRLM D,(C) ; STORE NEW SIZE IN OLD BLOCK
GO ARRET ; DONE
; HERE IN INSERT NEW BLOCK IN MIDDLE OF LIST
A8: MOVEI 0,(A) ; ADDRESS OF NEW BLOCK
ADDI 0,(B) ; END OF NEW BLOCK
CAILE 0,(D) ; OVERLAP WITH NEXT BLOCK ?
GO CODE [ ; YES, ERROR
CROAK AFRET CALLED WITH BAD ADDRESS
GO ARRET
]
CAIE 0,(D) ; CONTIGUOUS WITH NEXT BLOCK ?
GO A6 ; NO, APPEND TO PREVIOUS BLOCK
MOVS 0,(D) ; SWAPPED DOPE WORD OF NEXT BLOCK
ADDI 0,(B) ; SIZE OF COMBINED BLOCK
MOVSM 0,(A) ; MAKE DOPE WORD OF COMBINED BLOCK
HRRM A,(C) ; CHAIN IT TO PREVIOUS BLOCK
HLRZ D,(C) ; SIZE OF PREVIOUS BLOCK
ADDI D,(C) ; END OF PREVIOUS BLOCK
CAIE D,(A) ; CONTIGUOUS WITH PREVIOUS BLOCK ALSO ?
GO ARRET ; NO, DONE
HLRZ D,(C) ; SIZE OF PREVIOUS BLOCK
ADDI 0,(D) ; SIZE OF COMBINED BLOCK
MOVSM 0,(C) ; MERGE AGAIN
ARRET: RETURN ; DONE
;
; AFREZ - ALLOCATE ZEROED BLOCK
;
CENTRY AFREZ,[BSIZE]
CALL AFREE,[BSIZE] ; ALLOCATE A BLOCK
SETZM (A) ; ZERO FIRST WORD
MOVE B,BSIZE ; THE SIZE
SOJE B,AZRET ; NUMBER OF WORDS REMAINING TO BE ZEROED
ADDI B,(A) ; LAST WORD OF BLOCK
HRLZI C,(A) ; FIRST WORD OF BLOCK (LEFT HALF)
HRRI C,1(A) ; SECOND WORD OF BLOCK (RIGHT HALF)
BLT C,(B) ; TRANSFER ZEROES
AZRET: RETURN ; DONE
;
; ALOCSTAT - COMPUTE ALLOCATION STATISTICS
;
CENTRY ALOCSTAT,[PNALOC,PNBFREE]
MOVE A,FNWORDS ; NUMBER ALLOCATED
MOVEM A,@PNALOC
SETZ A, ; ZERO SUM OF FREE BLOCK SIZES
SETZM @PNBFREE ; ZERO COUNT OF FREE BLOCKS
MOVEI B,FLIST ; PREVIOUS BLOCK ADDR IN B
HRRZ C,(B) ; CURRENT BLOCK ADDR IN C
A9: HLRZ D,(C) ; GET SIZE OF BLOCK
ADD A,D ; ADD TO SUM
AOS @PNBFREE
MOVEI B,(C) ; CURRENT BLOCK -> PREVIOUS BLOCK
HRRZ C,(C) ; NEXT BLOCK -> CURRENT BLOCK
JUMPN C,A9 ; BLOCK EXISTS => LOOP
RETURN
END

25
src/clib/apfnam.c Normal file
View File

@@ -0,0 +1,25 @@
/**********************************************************************
APFNAME - Append suffix to file name
**********************************************************************/
char *apfname (dest, source, suffix)
char *dest, *source, *suffix;
{fnsfd (dest, source, 0, 0, 0, suffix, "", "");
return (dest);
}
/**********************************************************************
FNMKOUT - Make output file name
**********************************************************************/
char *fnmkout (dest, source, suffix)
char *dest, *source, *suffix;
{fnsfd (dest, source, "", 0, 0, suffix, "", "");
return (dest);
}

BIN
src/clib/ar2.clib
View File

Binary file not shown.

16
src/clib/atoi.c Normal file
View File

@@ -0,0 +1,16 @@
/**********************************************************************
ATOI - Convert string to Integer
**********************************************************************/
int atoi (s) char s[];
{int i, f, c;
if (!s) return (0);
i = f = 0;
if (*s == '-') {++s; ++f;}
while ((c = *s++)>='0' && c<='9') i = i*10 + c-'0';
return (f?-i:i);
}

20
src/clib/blt.cmid Normal file
View File

@@ -0,0 +1,20 @@
;
; BLT
;
; This file is PDP-10 dependent, system-independent.
;
TITLE BLT
.INSRT NC
.INSRT NM
CENTRY BLT,[FROM,TO,NUM]
HRRZ A,TO
HRRZI B,-1(A)
ADD B,NUM
HRL A,FROM
BLT A,(B)
RETURN
END

56
src/clib/c10boo.cmid Normal file
View File

@@ -0,0 +1,56 @@
;
; C10BOO - Bootstrapper Routine
;
; This file is ITS dependent.
;
TITLE BOOTSTRAP
.INSRT NC
.INSRT NM
LSTART==6 ; WHERE BOOTSTRAP LOADER WILL BE MOVED TO
LCHN==15 ; LOAD FILE CHANNEL
TCHN==16 ; TTY CHANNEL
CENTRY BOOTSTRAP,[FS]
MOVE C,FS
SYSCAL OPEN,[MOVSI 6?MOVEI LCHN?(C)?1(C)?2(C)?3(C)],LOSE
.SUSET [.ROPTI,,A] ; READ OPTION WORD
TLZ A,OPTOPC+OPTINT ; TURN OFF OLD PC ON MPV, IOC AND
; USE NEW INTERRUPT STACKING SCHEME
.SUSET [.SOPTI,,A] ; SET OPTION WORD
SETZM 42 ; DISABLE INTERRUPT HANDLING
SETZ A,
.SUSET [.SMASK,,A]
SETZM 41
.OPEN TCHN,[SIXBIT/ TTY/]
GO NOTTY
.CALL [SETZ ; TURN OFF ECHOING
'TTYSET
1000,,TCHN
[232222222222]
SETZ [230222220222]
]
JFCL
NOTTY: MOVE 0,[LOADER,,LSTART]
BLT 0,LSTART+LODLEN ; MOVE LOADER
JRST LSTART ; EXECUTE LOADER
LOSE: SETO A,
RETURN
;
; THE LOADING PROGRAM
;
LOADER:
.CALL [SETZ ? SIXBIT/LOAD/ ? MOVEI -1 ? SETZI LCHN]
.VALUE
.IOT LCHN,LSTART+5 ; READ STARTING ADDRESS
.CLOSE LCHN,
JRST @0 ; START PROGRAM
-1,,0 ; IOT POINTER
LODLEN==.-LOADER
END

54
src/clib/c10cor.cmid Normal file
View File

@@ -0,0 +1,54 @@
;
; C10COR - Basic Storage Allocation
;
; This file is ITS dependent.
;
TITLE CCORE
.INSRT NC
.INSRT NM
.GLOBAL FNWORD
;
; GETCORE - BASIC CORE ALLOCATOR
;
; GETCORE (SIZE) => SIZE,,ADDR
;
CENTRY GETCORE,[BSIZE],[NPAGES,PTR]
MOVE B,BSIZE
ADDI B,1777
LSH B,-10. ; NUMBER OF PAGES NEEDED
MOVEM B,NPAGES
CALL PGJGET,[NPAGES] ; GET PAGES
MOVN B,NPAGES ; MINUS NUMBER OF PAGES
JUMPLE A,CODE [
CROAK STORAGE EXHAUSTED
GO DOT
]
MOVEM A,PTR
HRL A,B ; AOBJN POINTER TO NEW PAGES
TRYAGN: .CALL [SETZ
'CORBLK
1000,,300000 ; WANT READ AND WRITE ACCESS
1000,,-1 ; PUT PAGE IN MY MAP
A ; WHERE TO PUT THEM
401000,,400001 ; GET FRESH PAGES
]
GO CODE [
CROAK UNABLE TO GET CORE
MOVEI 0,30.
.SLEEP 0,
GO TRYAGN
]
MOVE A,PTR
LSH A,10. ; POINTER TO FIRST PAGE
MOVE B,NPAGES
LSH B,10. ; NUMBER OF WORDS GOTTEN
ADDM B,FNWORDS ; SAVE FOR STATS
HRL A,B ; SIZE,,ADDR
RETURN
END

119
src/clib/c10exc.c Normal file
View File

@@ -0,0 +1,119 @@
# include "clib/c.defs"
int exctime 0;
int exccode 0;
/**********************************************************************
EXECS - Execute a program with a given command string
Returns:
-5 Job valretted something and was not continued.
-4 Internal fatal error.
-3 Unable to load program file.
-2 Unable to create job.
-1 Unable to open program file.
0 Job terminated normally.
other Job terminated abnormally with said PIRQ
Sets:
exctime - job's CPU time in 1/60 sec. units
exccode - contents of job's loc 1 at termination
**********************************************************************/
int execs (pname, args) char *pname, *args;
{int i, j, ich;
char *s, buf[40];
filespec f;
j = j_fload (pname);
if (j<0) return (j);
j_sjcl (j, args);
j_give_tty (j);
j_start (j);
while (TRUE)
{i = j_wait (j);
j_take_tty (j);
switch (i) {
case -1: return (-4);
case -2: i = 0;
break;
case -3: s = j_valret (j);
if (s)
{cprint ("Job valrets: ");
puts (s);
}
else
{puts ("Job .VALUE 0");
}
cprint ("continue? ");
gets (buf);
if (buf[0]=='y' || buf[0]=='Y')
{j_give_tty (j);
j_start (j);
continue;
}
i = -5;
break;
case -5: wsuset (014, 02); /* simulate ^Z typed */
sleep (15);
j_give_tty (j);
j_start (j);
continue;
default: cprint ("Unhandled interrupt, continue? ");
gets (buf);
if (buf[0]=='y' || buf[0]=='Y')
{j_give_tty (j);
j_start (j);
continue;
}
break;
}
break;
}
exctime = ruset (j_ch(j), 024) / (16666000./4069.);
exccode = 0;
if (!j_name (j, &f) && (ich=open(&f,4))>=0)
{uiiot (ich);
exccode = uiiot (ich);
close (ich);
}
j_kill (j);
return (i);
}
/**********************************************************************
EXECV - Execute file given a vector of arguments
**********************************************************************/
int execv (prog, argc, argv)
char *prog, *argv[];
{char **ap, **ep, buff[300], *p, *s;
int c;
p = buff;
ap = argv;
ep = argv + argc - 1;
while (ap <= ep)
{s = *ap++;
*p++ = '"';
while (c = *s++) *p++ = c;
*p++ = '"';
*p++ = ' ';
}
*p++ = 0;
return (execs (prog, buff));
}

50
src/clib/c10exp.c Normal file
View File

@@ -0,0 +1,50 @@
# include "c/c.defs"
/**********************************************************************
EXPAND ARGUMENT VECTOR CONTAINING FILE NAME PATTERNS
**********************************************************************/
static char **next;
static char *bufp;
int exparg (argc, argv, outv, buffer)
char *argv[], *outv[], buffer[];
{int i, expfs();
char *s;
bufp = buffer;
next = outv;
i = 0;
while (i<argc)
{s = argv[i++];
if (expmagic (s)) mapdir (s, expfs);
else *next++ = s;
}
return (next-outv);
}
int expmagic (s) /* does it contain magic pattern chars? */
char *s;
{int c, flag;
flag = FALSE;
while (c = *s++) switch (c) {
case '?':
case '*': flag = TRUE; continue;
case '/': flag = FALSE; continue;
case '\\': if (*s) ++s; continue;
}
return (flag);
}
expfs (fs)
filespec *fs;
{char *prfile (), *p;
p = bufp;
bufp = (prfile (fs, bufp)) + 1;
*next++ = p;
}

230
src/clib/c10fd.c Normal file
View File

@@ -0,0 +1,230 @@
# include "c.defs"
# include "its.bits"
/**********************************************************************
FD-ITS
File Directory Routines
ITS Version
**********************************************************************/
/**********************************************************************
FDMAP (P, F)
Call F(S) for all filenames S that match the pattern P.
**********************************************************************/
static int (*fff)();
fdmap (p, f)
char *p;
int (*f)();
{extern int fdzzzz();
fff = f;
mapdirec (p, fdzzzz);
}
/**********************************************************************
The following routines are internal and probably should
not be used by other programs.
**********************************************************************/
fdzzzz (fp)
filespec *fp;
{char fn[100];
prfile (fp, fn);
(*fff)(fn);
}
# define DIRSIZ 02000
# define ENTSIZ 5
/* some useful SIXBIT numbers */
# define _FILE_ 0164651544516 /* .FILE. */
# define _PDIRP_ 0104451621100 /* (DIR) */
# define _DSK_ 0446353000000
/**********************************************************************
MAPDIREC - Perform a function for each file in a
directory whose name matches a given pattern
(locked files not included)
**********************************************************************/
mapdirec (pattern, f)
char *pattern; /* the file name pattern */
int (*f)(); /* the function */
{filespec ff;
fparse (pattern, &ff);
return (mapdfs (&ff, f));
}
mapdfs (fp, f)
filespec *fp; /* the parsed pattern */
int (*f)(); /* the function */
{int n, v[2*DIRSIZ/ENTSIZ], *p, *q;
char pat1[10], pat2[10], buf[10];
filespec fs;
fs.dev = fp->dev;
fs.dir = fp->dir;
fs.fn1 = fp->fn1;
fs.fn2 = fp->fn2;
n = rddir (fp, v, 04);
if (fp->fn1) c6tos (fp->fn1, pat1);
if (fp->fn2) c6tos (fp->fn2, pat2);
q = v + 2*n;
for (p=v; p<q; p=+2)
{if (fp->fn1)
{c6tos (p[0], buf);
if (!smatch (pat1, buf)) continue;
}
if (fp->fn2)
{c6tos(p[1], buf);
if (!smatch (pat2, buf)) continue;
}
fs.fn1 = p[0];
fs.fn2 = p[1];
(*f)(&fs);
}
}
/**********************************************************************
RDIREC - Read A Directory
S is a string specifying a directory.
V will be filled with pairs of SIXBIT names, one for each file.
The number of files is returned.
**********************************************************************/
int rdirec (s, v, fs)
char *s;
int v[];
filespec *fs;
{fparse (s, fs);
if (!fs->dir) fs->dir = fs->fn1;
return (rddir (fs, v, 0));
}
/**********************************************************************
RDDIR - Read Directory
Return in V a list of names in the directory specified by FS.
OPT is used to filter out some files:
if (opt & 01) no-links
if (opt & 02) no-backed-up-files
if (opt & 04) no-locked-files
**********************************************************************/
int rddir (fp, v, opt)
filespec *fp;
int v[], opt;
{int buf[DIRSIZ], f, n, i, *p, d, n1, n2;
filespec fs;
fs.dev = fp->dev;
fs.dir = fp->dir;
fs.fn1 = _FILE_;
fs.fn2 = _PDIRP_;
if (!fs.dev) fs.dev = _DSK_;
if (!fs.dir) fs.dir = rsname();
f = open (&fs, BII);
if (f<0) return (0);
sysread (f, buf, DIRSIZ);
close (f);
n = (DIRSIZ - buf[1]) / ENTSIZ;
p = buf+buf[1];
i = 0;
while (--n >= 0)
{n1 = *p++;
n2 = *p++;
d = *p++ >> 18; /* random info */
p =+ 2;
if (d & 060) continue; /* should ignore these */
if (opt & d) continue; /* optionally ignore */
*v++ = n1;
*v++ = n2;
++i;
}
return (i);
}
/**********************************************************************
RMFD - Read the Master File Directory
V will be filled with SIXBIT names, one for each directory,
sorted.
The number of directories is returned.
**********************************************************************/
int rdmfd (v)
int v[];
{int ch, n, *e, *p, *q, i, j, x;
ch = fopen ("m.f.d. (file)", BII);
if (ch<0) return (ch);
n = sysread (ch, v, DIRSIZ);
close (ch);
e = v+n;
p = v+v[1];
q = v;
while (p<e) if (x = *p++) *q++ = x;
n = q-v-1; /* -1 for convenience in sort */
for (i=0; i<n; ++i)
for (j=i; j<=n; ++j)
if (v[j] < v[i]) {x=v[i];v[i]=v[j];v[j]=x;}
++n;
v[n] = 0;
return (n);
}
/**********************************************************************
a test routine
**********************************************************************/
# ifdef test
main ()
{char buf[50];
while (TRUE)
{cprint ("Pattern: ");
gets (buf);
mapdir (buf, prf);
}
}
prf (f)
filespec *f;
{char buf[100];
prfile (f, buf);
cprint ("%s\n", buf);
}
# endif

23
src/clib/c10fil.c Normal file
View File

@@ -0,0 +1,23 @@
#include "c.defs"
/**********************************************************************
RENAME (file1, file2)
Should work even if a file2 already exists.
Return 0 if no error.
*ITS VERSION*
**********************************************************************/
rename (s1, s2) char *s1, *s2;
{filespec fs1, fs2;
fparse (s1, &fs1);
fparse (s2, &fs2);
if (fs1.dev==0) fs1.dev = csto6 ("DSK");
sysdelete (&fs2);
sysrname (&fs1, &fs2);
return (0);
}

118
src/clib/c10fnm.c Normal file
View File

@@ -0,0 +1,118 @@
# include "c/c.defs"
/*
ITS filename cluster
components:
DEV:DIR;NAME TYP
All components manipulated without punctuation.
routines:
s = fngdv (old, buf) return DEV (in buf)
s = fngdr (old, buf) return DIR (in buf)
s = fngnm (old, buf) return NAME (in buf)
s = fngtp (old, buf) return TYP (in buf)
s = fnggn (old, buf) return null GEN (in buf)
s = fngat (old, buf) return null ATTR (in buf)
s = fnsdf (buf, old, dv, dir, nm, typ, gen, attr)
set null components of OLD
new value in BUF
(ignore 0 args)
s = fnsfd (buf, old, dv, dir, nm, typ, gen, attr)
set components of OLD
new value in BUF
(ignore 0 args)
fnparse (old, dv, dir, nm, typ, gen, attr)
parse OLD into components
*/
fnparse (old, dv, dir, nm, typ, gen, attr)
char *old, *dv, *dir, *nm, *typ, *gen, *attr;
{filespec temp;
fparse (old, &temp);
c6tos (temp.dev, dv);
c6tos (temp.dir, dir);
c6tos (temp.fn1, nm);
c6tos (temp.fn2, typ);
gen[0] = 0;
attr[0] = 0;
}
char *fngdv (old, buf)
char *old, *buf;
{filespec temp;
fparse (old, &temp);
c6tos (temp.dev, buf);
return (buf);
}
char *fngdr (old, buf)
char *old, *buf;
{filespec temp;
fparse (old, &temp);
c6tos (temp.dir, buf);
return (buf);
}
char *fngnm (old, buf)
char *old, *buf;
{filespec temp;
fparse (old, &temp);
c6tos (temp.fn1, buf);
return (buf);
}
char *fngtp (old, buf)
char *old, *buf;
{filespec temp;
fparse (old, &temp);
c6tos (temp.fn2, buf);
return (buf);
}
char *fnggn (old, buf)
char *old, *buf;
{buf[0] = 0;
return (buf);
}
char *fngat (old, buf)
char *old, *buf;
{buf[0] = 0;
return (buf);
}
char *fnsdf (buf, old, dv, dir, nm, typ, gen, attr)
char *old, *buf, *dv, *dir, *nm, *typ, *gen, *attr;
{filespec temp;
fparse (old, &temp);
if (dv && temp.dev==0) temp.dev = csto6 (dv);
if (dir && temp.dir==0) temp.dir = csto6 (dir);
if (nm && temp.fn1==0) temp.fn1 = csto6 (nm);
if (typ && temp.fn2==0) temp.fn2 = csto6 (typ);
prfile (&temp, buf);
return (buf);
}
char *fnsfd (buf, old, dv, dir, nm, typ, gen, attr)
char *old, *buf, *dv, *dir, *nm, *typ, *gen, *attr;
{filespec temp;
fparse (old, &temp);
if (dv) temp.dev = csto6 (dv);
if (dir) temp.dir = csto6 (dir);
if (nm) temp.fn1 = csto6 (nm);
if (typ) temp.fn2 = csto6 (typ);
prfile (&temp, buf);
return (buf);
}

95
src/clib/c10fo.cmid Normal file
View File

@@ -0,0 +1,95 @@
;
; FCOUT - FAST CHARACTER OUTPUT ROUTINES
;
; This file is ITS dependent.
;
TITLE FCOUT
.INSRT NC
.INSRT NM
BLKSIZ==200
BLKCNT==5*BLKSIZ
NL==12
CR==15
; SIOT STUFF
.UDATA
SBUF: BLOCK BLKSIZ
SPTR: BLOCK 1
SCHN: BLOCK 1
SCNT: BLOCK 1
.IDATA
SBPT: 440700,,SBUF
.CODE
CENTRY OOPN,[NAME]
CALL FOPEN,[NAME,[[1]]]
JUMPL A,OP$RET ; NEGATIVE FAILURE CODE
MOVEM A,SCHN ; ITS CHANNEL (RETURNED)
MOVEI B,BLKCNT
MOVEM B,SCNT
MOVE B,SBPT
MOVEM B,SPTR
OP$RET: RETURN
CENTRY OFLS ; FLUSH BUFFER
MOVEI C,BLKCNT
SUB C,SCNT
JUMPLE C,FL$RET
MOVE D,SBPT
SYSCAL SIOT,[SCHN ? D ? C]
FL$RET: MOVE D,SBPT
MOVEM D,SPTR
MOVEI D,BLKCNT
MOVEM D,SCNT
RETURN
CENTRY OUTI,[CC] ; OUTPUT IMAGE CHARACTER
MOVE A,CC
IDPB A,SPTR
SOSG SCNT
CALL OFLS
RETURN
CENTRY OUTC,[CC] ; OUTPUT ASCII CHARACTER
MOVE A,CC
CAIN A,NL
GO OC$NL
OC$1: IDPB A,SPTR
SOSG SCNT
CALL OFLS
RETURN
OC$NL: MOVEI A,CR
IDPB A,SPTR
SOSG SCNT
CALL OFLS
MOVEI A,NL
GO OC$1
CENTRY OUTS,[STR] ; OUTPUT ASCII STRING
MOVE B,STR
OS$2: SKIPN A,(B)
GO OS$RET
ADDI B,1
CAIN A,NL
GO OS$NL
OS$1: IDPB A,SPTR
SOSG SCNT
CALL OFLS
GO OS$2
OS$NL: MOVEI A,CR
IDPB A,SPTR
SOSG SCNT
CALL OFLS
MOVEI A,NL
GO OS$1
OS$RET: RETURN
CENTRY OCLS ; CLOSE FILE
CALL OFLS
SYSCAL CLOSE,[SCHN]
RETURN
END

406
src/clib/c10int.cmid Normal file
View File

@@ -0,0 +1,406 @@
;
; INTRUP - C INTERRUPT SYSTEM
;
; This file is ITS dependent.
;
TITLE INTRUP
.INSRT NC
.INSRT NM
.GLOBAL UUOH,USAVEA,USAVEB,USAVEC,USAVED
.GLOBAL PDLTOP
; SOME C INTERRUPT NUMBERS
CH0I==16. ; CHANNEL 0 INTERRUPT
IN0I==32. ; INFERIOR 0 INTERRUPT
MPV==1. ; MPV INTERRUPT
CTRSI==41. ; CONTROL-S INTERRUPT
CTRGI==42. ; CONTROL-G INTERRUPT
NINT==42. ; NUMBER OF INTERRUPTS
; TAB1 - CONVERTS FIRST WORD INTERRUPTS TO C INTERRUPT NUMBER
.PDATA
MDATA TAB1
0 ? 0 ? 10. ? 0 ? 0 ? 0
0 ? 0 ? 0 ? 15. ? 7. ? 6.
5. ? 0 ? 0 ? 0 ? 0 ? 0
13. ? 0 ? 0 ? 4. ? 1. ? 9.
0 ? 0 ? 0 ? 2. ? 0 ? 8.
3. ? 0 ? 14. ? 0 ? 0 ? 12.
; TAB2 - CONTAINS HANDLERS FOR AND INFORMATION ABOUT C INTERRUPTS
; BITS 0-17 HANDLER (0 => DEFAULT, 1 => IGNORE, OTHER => ROUTINE ADDR)
; BITS 18-23 BIT NUMBER IN ITS MASK WORD
; BIT 24 ITS MASK WORD NUMBER
.IDATA
MDATA TAB2
0 ; NOT USED
15,,0 ; MPV
10,,0 ; IOC
5,,0 ; ILOPR
16,,0 ; MAR
27,,0 ; UTRAP
30,,0 ; PURE
31,,0 ; WIRO
6,,0 ; SYSDOWN
14,,0 ; CLOCK
41,,0 ; TIMER
0 ; PDLOV (NOT USED)
0,,0 ; TTYI
21,,0 ; CLI
3,,0 ; OVERFLOW
32,,0 ; FLOATING OVERFLOW
100,,0 ; CHANNEL 0
101,,0 ; CHANNEL 1
102,,0 ; CHANNEL 2
103,,0 ; CHANNEL 3
104,,0 ; CHANNEL 4
105,,0 ; CHANNEL 5
106,,0 ; CHANNEL 6
107,,0 ; CHANNEL 7
110,,0 ; CHANNEL 10
111,,0 ; CHANNEL 11
112,,0 ; CHANNEL 12
113,,0 ; CHANNEL 13
114,,0 ; CHANNEL 14
115,,0 ; CHANNEL 15
116,,0 ; CHANNEL 16
117,,0 ; CHANNEL 17
122,,0 ; INFERIOR 0
123,,0 ; INFERIOR 1
124,,0 ; INFERIOR 2
125,,0 ; INFERIOR 3
126,,0 ; INFERIOR 4
127,,0 ; INFERIOR 5
130,,0 ; INFERIOR 6
131,,0 ; INFERIOR 7
0 ; NOT USED
0 ; CONTROL-S INTERRUPT
0 ; CONTROL-G INTERRUPT
;
; ON - SPECIFY AN ACTION FOR A C INTERRUPT
;
.CODE
CENTRY ON,[INTNO,NEWH]
MOVE B,INTNO ; INTERRUPT #
JUMPLE B,ON2 ; BAD #
CAILE B,NINT ; NINT = HIGHEST VALID #
GO ON2 ; BAD #
HRRZ A,NEWH ; NEW HANDLER
CAIL B,CTRSI
GO ON1 ; SOFTWARE INTERRUPT
LDB D,[220600,,TAB2(B)] ; BIT #
MOVEI C,1
LSH C,(D) ; MASK
LDB D,[300100,,TAB2(B)] ; WORD #
CAIN B,CTRGI
JUMPE A,TURNON
JUMPE A,TURNOF
CAIE A,1
GO TURNON
CAIGE B,8.
GO TURNON
TURNOF: .SUSET [.SAMASK,,C ? .SAMSK2,,C](D)
GO ON1
TURNON: .SUSET [.SIMASK,,C ? .SIMSK2,,C](D)
ON1: HRRZ C,TAB2(B) ; OLD HANDLER
HRRM A,TAB2(B) ; NEW HANDLER
MOVE A,C ; RETURN OLD HANDLER
ONRET: RETURN
ON2: CROAK ON: INVALID INTERRUPT NUMBER
MOVEI A,1
GO ONRET
;
; SIGNAL - SIGNAL A C INTERRUPT
;
CENTRY SIGNAL,[SIGNO]
MOVE A,SIGNO ; INTERRUPT #
JUMPLE A,S3 ; BAD #
CAILE A,NINT ; NINT = HIGHEST VALID #
GO S3 ; BAD #
HRRZ B,TAB2(A) ; HANDLER
CAIN B,1
GO SIGRET ; 1 => IGNORE
JUMPN B,S1 ; SPECIFIED HANDLER
CAIN A,CTRGI
GO S4 ; HANDLE ^G INTERRUPT
GO SIGRET ; OTHERWISE IGNORE
S1: CAIGE A,CH0I
GO S2 ; NO ARG
CAILE A,IN0I+7
GO S2 ; NO ARG
CAIGE A,IN0I
SUBI A,CH0I ; ARG IS CHANNEL #
CAIL A,IN0I
SUBI A,IN0I ; ARG IS INFERIOR #
VCALL (B),[A]
GO SIGRET
S2: CAIN A,CTRSI
CL CTRSIH ; SPECIAL ^S ACTION
CAIN A,CTRGI
CL CTRGIH ; SPECIAL ^G ACTION
VCALL (B)
GO SIGRET
S3: CROAK INVALID INTERRUPT SIGNALLED
GO SIGRET
S4: CL CTRGIH
CALL STKDMP
CROAK -- ^G --
SIGRET: RETURN
; SPECIAL HANDLER FOR CONTROL-S INTERRUPT
IENTRY CTRSIH
PPUSH A
PPUSH B
CTRS1: SETO B,
SYSCAL IOT,[5000,,%TIACT+%TIINT+%TINWT ? TYICHN" ? 2000,,B]
JUMPLE B,CTRS2
CAIE B,^S
GO CTRS1
CTRS2: PPOP B
PPOP A
RTN
; SPECIAL HANDLER FOR CONTROL-G INTERRUPT
IENTRY CTRGIH
PPUSH A
PPUSH B
CTRG1: SETO B,
SYSCAL IOT,[5000,,%TIACT+%TIINT+%TINWT ? TYICHN ? 2000,,B]
JUMPLE B,CTRG2
CAIE A,^G
GO CTRG1
CTRG2: PPOP B
PPOP A
RTN
;
; DISMISS - DISMISS INTERRUPT AND RETURN TO CALLER
;
MENTRY DISMISS
SYSCAL DISMIS,[5000,,T%CTL ? INTPTR ? 1000,,.+2]
RETURN
;
; GETPC - GET INTERRUPTED PC
;
CENTRY GETPC
MOVE D,INTPTR ; TOP OF INTERRUPT STACK
MOVEI D,-T%SIZ+1(D) ; BOTTOM OF FRAME
HRRZ A,T%OPC(D)
RETURN
;
; SETPC - SET INTERRUPTED PC
;
CENTRY SETPC,[PC]
MOVE D,INTPTR ; TOP OF INTERRUPT STACK
MOVEI D,-T%SIZ+1(D) ; BOTTOM OF FRAME
MOVE A,PC
HRRM A,T%OPC(D)
RETURN
;
; INTERRUPT HANDLING SPECIFICATONS
;
T%NRG==4 ; NUMBER OF REGISTERS PUSHED
T%IW1==0 ; OFFSET OF 1ST INTERRUPT WORD
T%IW2==1 ; OFFSET OF 2ND INTERRUPT WORD
T%DF1==2 ; OFFSET OF 1ST OLD DEFER WORD
T%DF2==3 ; OFFSET OF 2ND OLD DEFER WORD
T%OPC==4 ; OFFSET OF OLD PC
T%REG==5 ; OFFSET OF FIRST SAVED REGISTER
T%SIZ==T%REG+T%NRG ; SIZE OF INTERRUPT FRAME
T%CTL==A*100+T%NRG ; CONTROL ARG FOR PUSHING REGS
MDATA TSINT
T%CTL,,INTPTR ; PUSH REGISTERS ON INTERRUPT STACK
%PIPDL ? 0 ; HANDLE PDL-OVERFLOW
-1 ? -1 ; DEFER ALL INTERRUPTS
PDLOVH ; PDL-OVERFLOW HANDLER
%PIMPV ? 0 ; HANDLE MPV
#%PIPDL ? -1 ; DEFER ALL BUT PDL-OVERFLOW
MPVH ; MPV HANDLER
#<%PIMPV+%PIPDL> ? 0 ; HANDLE ALL OTHER FIRST WORDERS
#<%PIMPV+%PIPDL> ? -1 ; DEFER ALL BUT MPV AND PDLOV
TSINT1 ; INTERRUPT HANDLER
0 ? -1 ; HANDLE ALL SECOND WORDERS
#<%PIMPV+%PIPDL> ? -1 ; DEFER ALL BUT MPV AND PDLOV
TSINT2 ; INTERRUPT HANDLER
TSINTL"==21. ; .-TSINT DOESN'T WORK DUE TO MIDAS BUG
;
; INTERRUPT STACK
;
INTPSZ==2*TSINTL ; SIZE OF INTERRUPT STACK
.IDATA
MDATA INTPTR
-INTPSZ,,INTPDL
MDATA INTPDL
BLOCK INTPSZ-1
-1 ; THIS PAGE MUST NOT BE DELETED!
.CODE
;
; MPV HANDLER
;
IENTRY MPVH
.SUSET [.RMPVA,,B] ; GET LOSING ADDRESS
; NOTE THAT ON KA-10 THIS ADDRESS
; IS ROUNDED DOWN TO FIRST WORD
; OF PAGE
TRZ B,1777 ; ROUND DOWN ANYWAY (FOR KL-10)
CAMGE B,SEG0LO" ; MAYBE IN SEGMENT 0?
GO MPV$0 ; NO
CAMG B,SEG0HI" ; IN SEGMENT 0?
GO MPV$1 ; YES
MPV$0: CAMGE B,SEG1LO" ; MAYBE IN SEGMENT 1?
GO TSINT1 ; NO
CAMLE B,SEG1HI" ; IN SEGMENT 1?
GO TSINT1 ; NO
; HERE IF ADDRESS IS IN SEGMENT 1
MOVE C,PDLTOP ; TOP END OF STACK
SUBI C,2000
TRZ C,1777 ; LAST FULL PAGE OF STACK
CAME B,C ; REFERENCE TO LAST PAGE OF STACK?
GO MPV$1 ; NO
CROAK IMMINENT STACK OVERFLOW
MPV$1: LSH B,-10. ; PAGE NUMBER
SYSCAL CORTYP,[B ? SETZM C] ; GET PAGE INFO
JUMPN C,TSINT1 ; PAGE EXISTS => MPV ON ANOTHER JOB
MPV$2: SYSCAL CORBLK,[1000,,%CBNDW ? 1000,,-1 ? B ? 1000,,%JSNEW],MPVLOS
GO INTDIS
MPVLOS: CROAK UNABLE TO GET ZERO PAGE
GO MPV$2
;
; HANDLER FOR FIRST WORD INTERRUPTS
;
IENTRY TSINT1
MOVE D,INTPTR ; TOP OF INTERRUPT STACK
MOVEI D,-T%SIZ+1(D) ; BOTTOM OF FRAME
MOVE A,T%IW1(D) ; GET INTERRUPT WORD
JFFO A,.+2 ; GET FIRST BIT
GO INTDIS ; NONE (?)
MOVE A,TAB1(B) ; C INTERRUPT NUMBER
JUMPE A,IGNORE ; NOT HANDLED
HRRZ B,TAB2(A) ; HANDLER
CAIN B,1
GO IGNORE ; 1 MEANS IGNORE
JUMPN B,TS1 ; HANDLER SPECIFIED
CAIN A,MPV
GO FATMPV
CAIN A,CTRGI
GO TS1 ; DEFAULT IS NOT TO IGNORE
IGNORE: AOS T%OPC(D) ; OTHERWISE - THE DEFAULT
GO INTDIS ; IS TO CONTINUE WITH THE
; NEXT INSTRUCTION
; HERE IF FATAL MPV OCCURS
FATMPV: MOVEI A,%PIMPV
IORM A,T%DF1(D) ; MAKE MPV DEFFERED
GO INTDIS ; NOW DISMISS - WILL MAKE FATAL
;
; SECOND WORD INTERRUPT HANDLER
;
IENTRY TSINT2
MOVE D,INTPTR ; TOP OF INTERRUPT STACK
MOVEI D,-T%SIZ+1(D) ; BOTTOM OF FRAME
MOVE A,T%IW2(D) ; GET INTERRUPT WORD
JFFO A,.+2
GO INTDIS
CAILE B,17.
GO CHANI
CAIGE B,10.
GO INTDIS
MOVN A,B
ADDI A,17.+IN0I
GO TS1
CHANI: CAIGE B,19.
GO INTDIS
MOVN A,B
ADDI A,35.+CH0I
GO TS1
;
; HERE TO SIGNAL SOMETHING WITH ARG IN A
;
DEFINE PUSHL LIST
IRP X,,[LIST]
PPUSH X
TERMIN!TERMIN
DEFINE POPL LIST
IRP X,,[LIST]
PPOP X
TERMIN!TERMIN
TS1: ADDI P,20 ; IN CASE EPILOG INTERRUPTED
PUSHL [0,5,6,7,10,11,12,13,14,15,16]
PUSHL [40,USAVEA,USAVEB,USAVEC,USAVED,UUOH]
CALL SIGNAL,[A]
POPL [UUOH,USAVED,USAVEC,USAVEB,USAVEA,40]
POPL [16,15,14,13,12,11,10,7,6,5,0]
SUBI P,20
PDLOVH:
INTDIS: SYSCAL DISMIS,[5000,,T%CTL ? INTPTR]
IENTRY ETSINT
END

848
src/clib/c10io.c Normal file
View File

@@ -0,0 +1,848 @@
# include "c/c.defs"
# include "c/its.bits"
/*
*
* CIO - C I/O Routines (written in C)
*
* Routines:
*
* fd = copen (fname, mode, opt)
* c = getchar ()
* gets (s)
* putchar (c)
* puts (s)
* ch = mopen (f, mode)
* rc = mclose (ch)
* rc = fparse (s, f)
* s = prfile (f, s)
* ch = fopen (fname, mode)
* ch = open (&filespec, mode)
* argc = fxarg (argc, argv)
* n = prsarg (in, out, argv, job)
* valret (s)
* c6 = ccto6 (c)
* c = c6toc (c6)
* w = csto6 (s)
* s = c6tos (w, s)
*
* Internal routines:
*
* c0init () [called by startup routine]
* fd = c0open (fname, mode)
* w = cons (lh, rh)
* s = filscan (b, s)
* s = c6q2s (w, s)
*
* Variables:
*
* cin - standard input channel
* cout - standard output channel
* cerr - standard error output channel
*
* cinfn - standard input file name (if redirected)
* coutfn - standard output file name (if redirected)
* cerrfn - standard errout file name (if redirected)
*
*
*/
# rename c0fcbs "C0FCBS"
# rename gettab "GETTAB"
# rename puttab "PUTTAB"
# rename clotab "CLOTAB"
# rename gc_bad "GC$BAD"
# rename pc_bad "PC$BAD"
# rename cl_bad "CL$BAD"
# rename prsarg "PRSARG"
# rename fcbtab "FCBTBL"
# rename tty_input_channel "TYICHN"
# rename tty_output_channel "TYOCHN"
# rename setappend "SETAPP"
# define _magic 37621 /* a magic number for validation */
# define buf_siz 0200
# define fcb_siz 7
# define NCHANNEL 10 /* number of CHANNELs */
# define phyeof_flag 001
# define open_flag 002
# define write_flag 004
# define tty_flag 010
# define unset_flag 020
# define QUOTE 021 /* control-Q, for file names */
# define _DSK 0446353000000 /* sixbit for DSK */
# define _GREATER 0360000000000 /* sixbit for > */
# define _TTY 0646471000000 /* sixbit for TTY */
# define _FILE 0164651544516 /* sixbit for .FILE. */
# define _DIR 0104451621100 /* sixbit for (DIR) */
channel cin, /* standard input unit */
cout, /* standard output unit */
cerr; /* standard error output unit */
char *cinfn, /* standard input file name, if redirected */
*coutfn, /* standard output file name, if redirected */
*cerrfn; /* standard errout file name, if redirected */
int cerrno; /* system OPEN error codes returned here */
extern int c0fcbs[], fcbtab[], puttab[], gettab[], clotab[],
gc_bad[], pc_bad[], cl_bad[];
/**********************************************************************
COPEN - CIO Open File
Open a file, given a file name, an optional mode, and an
optional options string. The possible modes are
'r' - read
'w' - write
'a' - append
The default mode is read. Normally, I/O is character oriented
and produces text files. In particular, the lines of a text
file are assumed (by the user) to be separated by newline
characters with any conversion to the system format performed
by the I/O routines.
If an options string is given and contains the character "b",
then I/O is integer (word) - oriented and produces image files.
I/O to and from character strings in core is accomplished by
including "s" in the options string and supplying a character
pointer to the string to be read or written into as the first
argument to COPEN. Closing a string open for write will
append a NULL character to the string and return a character
pointer to that character.
COPEN returns a CHANNEL, which is a pointer to a control block.
The external variables CIN, COUT, and CERR contain already-open
channels for standard input, standard output, and standard
error output, respectively.
COPEN returns OPENLOSS in case of error. The system error code is
stored in CERRNO.
**********************************************************************/
channel copen (fname, mode, opt)
char *fname;
{int *fcbp, i, fmode, bmode, its_mode, flags;
int chan, buffp, state, bcnt, device, c, sflag, *ip;
char *p, buf[5], *ep;
filespec f;
cerrno = 0;
if (mode<'A' || mode>'z') mode = 'r';
p = opt;
if (opt<0100 || opt>=01000000) p = "";
else if (p[0]<'A' || p[0]>'z') p = "";
flags = open_flag;
fmode = 0;
switch (lower (mode)) {
case 'r': fmode = 0; break;
case 'w': fmode = 1; break;
case 'a': fmode = 2; break;
default: cerrno = 012; /* mode not available */
return (OPENLOSS);
}
bmode = 0;
sflag = FALSE;
while (c = *p++) switch (lower (c)) {
case 'b': bmode = 4; break;
case 's': sflag = TRUE; break;
}
if (c0fcbs[0] != _magic) c0init(); /* initialize */
for (i=0; i<NCHANNEL; ++i)
{fcbp = fcbtab[i];
if (!(fcbp[0] & open_flag)) break;
}
if (i>=NCHANNEL)
{cerrno = 06; /* device full */
return (OPENLOSS);
}
chan = -1;
buffp = fcbp[0] >> 18;
if (sflag) /* string I/O */
{state = 3;
if (fmode==2) /* append */
while (*fname) ++fname;
}
else /* file I/O */
{state = 1;
fparse (fname, &f); /* parse file name */
if (f.dev == _TTY /* TTY special case */
&& (f.fn1 != _FILE || f.fn2 != _DIR))
{state = 0;
bmode = 0;
device = 0;
chan = -1;
flags =| tty_flag;
}
else /* normal case */
{if (f.dev == 0) f.dev = _DSK;
if (f.dir == 0) f.dir = rsname();
if (f.fn2 == 0) f.fn2 = _GREATER;
its_mode = (fmode==2 ? 0100001 : fmode);
its_mode =| 2; /* block mode */
its_mode =| bmode; /* image mode */
if (fmode==2 && !bmode) /* char append */
{chan = setappend (&f, its_mode, buf, &ep);
if (chan == -04) /* not found */
{chan = mopen (&f, its_mode & 077);
fmode = 1;
}
}
else chan = mopen (&f, its_mode);
if (chan<0) {cerrno = -chan; return (OPENLOSS);}
device = status (chan) & 077; /* device code */
if (bmode && device<=2) /* TTY in IMAGE mode ?? */
{close (chan);
bmode = 0;
its_mode =& ~4;
chan = mopen (&f, its_mode);
if (chan<0) {cerrno = -chan; return (OPENLOSS);}
device = status (chan) & 077;
}
if (state==1)
if (buffp==0)
{buffp = salloc (buf_siz);
if (buffp == -1)
{cerrno = 037; /* no core available */
return (OPENLOSS);
}
}
else
{i = buf_siz;
ip = buffp;
while (--i >= 0) *ip++ = 0;
}
}
}
bcnt = -1; /* special initialization hack */
if (fmode)
{bcnt = 5*buf_siz; /* char count */
if (bmode) bcnt = buf_siz; /* word count */
flags =| write_flag;
}
if (bmode && !sflag) state = 2;
if (chan < 0) {flags =| unset_flag; chan = 0;}
fcbp[0] = (buffp<<18) | ((chan&017)<<14) | ((device&077)<<8) | flags;
fcbp[2] = bcnt;
if (sflag) fcbp[1] = fname;
else fcbp[1] = cons (bmode ? 0 : 0440700, buffp);
if (fcbp[3]==0) fcbp[3] = salloc(20);
else fcbp[3] =& 0777777;
if (fmode) state =+ 4;
fcbp[4] = cons (clotab[state], fcbp[5]=gettab[state]);
fcbp[6] = puttab[state];
if (fmode==2 && !sflag) /* file append */
{i = fillen (chan);
if (bmode) access (chan, i); /* access to end of file */
else if (i>0)
{access (chan, i-1); /* write over last word */
p = buf;
while (p < ep) cputc (*p++ | 0400, fcbp);
}
}
return (fcbp);
}
/**********************************************************************
SETAPPEND - Set up for character append
**********************************************************************/
int setappend (fp, mode, buf, epp) filespec *fp; char buf[], **epp;
{int count, n, chan, wordlen, chanlen, c;
char *p;
count = 5; /* try 5 times */
while (--count>=0)
{p = buf;
chan = mopen (fp, UII);
if (chan < 0) return (chan);
wordlen = fillen (chan);
close (chan);
chan = mopen (fp, UAI);
if (chan < 0) return (chan);
chanlen = fillen (chan);
if (chanlen > 0)
{if (chanlen == wordlen) --chanlen;
else chanlen = ((chanlen-1)/5)*5;
access (chan, chanlen);
n = 5;
while (--n>=0 && (c = uiiot (chan)) >= 0 && c != 3)
*p++ = c;
}
close (chan);
*epp = p;
chan = mopen (fp, mode);
if (chan<0) return (chan);
if (wordlen == fillen(chan)) return (chan);
close (chan);
}
return (-012);
}
/**********************************************************************
GETCHAR - Read a character from the standard input unit
**********************************************************************/
getchar () {return (cgetc (cin));}
/**********************************************************************
GETS - Read a string from the standard input unit
**********************************************************************/
gets (p)
char *p;
{int c;
while ((c = cgetc (cin)) != '\n' && c>0) *p++ = c;
*p = 0;
}
/**********************************************************************
PUTCHAR - Output a character to the standard output unit
**********************************************************************/
putchar (c)
int c;
{return (cputc (c, cout));}
/**********************************************************************
PUTS - Output a string to the standard output unit
**********************************************************************/
puts (s)
char *s;
{int c;
while (c = *s++) cputc (c, cout);
cputc ('\n', cout);
}
/**********************************************************************
MOPEN - OPEN FILE
Open file given filespec and mode.
Return ITS channel number or -FC if unsuccessful.
Same as OPEN, except handles TTY specially
and waits if file is locked.
**********************************************************************/
channel mopen (f, mode) filespec *f; int mode;
{int ch, n;
if (f->dev == _TTY && !(f->fn1 == _FILE && f->fn2 == _DIR))
return (mode & 1 ? tyoopn() : tyiopn());
ch = open (f, mode);
n = 8;
while (ch == -023 && --n>=0) /* file locked */
{sleep (30);
ch = open (f, mode);
}
return (ch);
}
/**********************************************************************
MCLOSE - Close ITS channel, unless its the TTY.
**********************************************************************/
mclose (ch) channel ch;
{extern int tty_input_channel, tty_output_channel;
if (ch == tty_input_channel) return (0);
if (ch == tty_output_channel)
{tyo_flush ();
return (0);
}
return (close (ch));
}
/**********************************************************************
FPARSE - Convert an ASCIZ string representation of an ITS
file name or a path name to a FILESPEC.
Return 0 if OK, -1 if bad path name format.
**********************************************************************/
fparse (s, f) char s[]; filespec *f;
{int i, c, fnc, n_slash, no_its_chars, n_dot;
char buf[7], *p, *filscan();
f->dev = f->dir = f->fn1 = f->fn2 = 0;
/* check for path name */
p = s;
no_its_chars = TRUE;
n_slash = n_dot = 0;
while (c = *p++) switch (c) {
case QUOTE: if (*p) ++p; break;
case '.': ++n_dot; break;
case '/': ++n_slash; break;
case ' ':
case ':':
case ';': no_its_chars = FALSE; break;
}
if (no_its_chars && (n_dot>0 || n_slash>0))
/* here if path name */
{p = s;
if (*p=='/')
{--n_slash;
p = filscan (buf, ++p, &n_dot, &n_slash);
f->dev = csto6(buf);
c = *p++;
if (c!='/') return (-1);
}
p = filscan (buf, p, &n_dot, &n_slash);
c = *p++;
if (c=='/')
{f->dir = csto6(buf);
p = filscan (buf, p, &n_dot, &n_slash);
c = *p++;
}
if (c=='.')
{f->fn1 = csto6(buf);
p = filscan (buf, p, &n_dot, &n_slash);
c = *p++;
}
if (f->fn1) f->fn2 = csto6(buf);
else f->fn1 = csto6(buf);
return (0);
}
/* here if ITS file name */
p = s;
fnc = i = 0;
buf[0] = 0;
do {c = *p++;
switch (c) {
case ':': f->dev = csto6(buf);
i = 0;
break;
case ';': f->dir = csto6(buf);
i = 0;
break;
case ' ':
case 0: if (buf[0]) switch (fnc++) {
case 0: f->fn1 = csto6(buf); break;
case 1: f->fn2 = csto6(buf); break;
}
i = 0;
break;
default: if (c==QUOTE && *p) c = *p++;
if (i<6) buf[i++] = c;
}
buf[i] = 0;
}
while (c);
return (0);
}
/**********************************************************************
FILSCAN - scan for part of file name
**********************************************************************/
char *filscan (b, q, andot, anslash)
char *b, *q;
int *andot, *anslash;
{int c;
char *p;
p = q++;
while (c = *p++)
{if (c=='/') {--*anslash; break;}
else if (c=='.')
{if (--*andot == 0 && *anslash==0 && *p &&
p!=q) break;}
else if (c==QUOTE && *p) c = *p++;
*b++ = c;
}
*b = 0;
return (--p);
}
/**********************************************************************
PRFILE - convert FILESPEC to ITS file name
**********************************************************************/
char *prfile(f,p) filespec *f; char *p;
{char *c6q2s();
if (f->dev) {p = c6q2s (f->dev, p); *p++ = ':';}
if (f->dir) {p = c6q2s (f->dir, p); *p++ = ';';}
if (f->fn1) {p = c6q2s (f->fn1, p); *p++ = ' ';}
if (f->fn2) {p = c6q2s (f->fn2, p);}
*p = 0;
return (p);
}
/**********************************************************************
FOPEN - Open file given file name
**********************************************************************/
channel fopen (fname, mode) char *fname; int mode;
{filespec f;
fparse (fname, &f);
if (f.dev == 0) f.dev = _DSK;
if (f.dir == 0) f.dir = rsname();
return (open (&f, mode));
}
/**********************************************************************
OPEN - Open file given filespec
**********************************************************************/
channel open (f, mode) filespec *f; int mode;
{channel c;
int rc;
c = chnloc();
if (c<0) return (-014); /* bad channel number */
rc = sysopen (c, f, mode);
if (rc) return (rc);
return (c);
}
/**********************************************************************
FXARG - Process Command Arguments to Set Up
Redirection of Standard Input and Output
This routine is called by the C start-up routine.
**********************************************************************/
int fxarg (argc, argv) int argc; char *argv[];
{char **p, **q, *s;
int i, append, errappend, f;
i = argc; /* number of arguments given */
argc = 0; /* number of arguments returned */
p = argv; /* source pointer */
q = argv; /* destination pointer */
while (--i >= 0) /* for each argument given */
{s = *p++; /* the argument */
switch (s[0]) {
case '<': if (s[1]) cinfn = s+1; break;
case '>': if (s[1] == '>')
{if (s[2]) {coutfn = s+2; append = TRUE;}}
else {if (s[1]) {coutfn = s+1; append = FALSE;}}
break;
case '%': if (s[1] == '%')
{if (s[2]) {cerrfn = s+2; errappend=TRUE;}}
else {if (s[1]) {cerrfn = s+1; errappend = FALSE;}}
break;
default: /* normal argument */
++argc; *q++ = s;
}
}
/* now hack the standard file descriptors */
if (cinfn) /* input is redirected */
{f = c0open (cinfn, 'r');
if (f != OPENLOSS) {cclose (cin); cin = f;}
}
if (coutfn) /* output is redirected */
{f = c0open (coutfn, append ? 'a' : 'w');
if (f != OPENLOSS) {cout = f;}
}
if (cerrfn) /* errout is redirected */
{f = c0open (cerrfn, errappend ? 'a' : 'w');
if (f != OPENLOSS)
{if (cerr!=cout) cclose (cerr); cerr = f;}
}
return (argc);
}
/**********************************************************************
C0OPEN - Open with error message
**********************************************************************/
channel c0open (name, mode)
{channel f;
f = copen (name, mode, 0);
if (f == OPENLOSS) cprint (cerr, "Unable to open '%s'\n", name);
return (f);
}
/**********************************************************************
C0INIT - Initialization for C I/O Routines.
This routine is normally called first by the C start-up routine.
**********************************************************************/
c0init ()
{int *p, i;
c0fcbs[0] = _magic;
p = &c0fcbs[1];
i = NCHANNEL*fcb_siz;
while (--i >= 0) *p++ = 0;
i = NCHANNEL;
while (--i >= 0)
{p = &c0fcbs[fcb_siz*i+5];
p[0] = cons (cl_bad, gc_bad);
p[1] = gc_bad;
p[2] = pc_bad;
}
cin = copen ("/tty", 'r', 0); /* standard input */
cout = cerr = copen ("/tty", 'w', 0); /* standard output */
/* These calls do not actually open the TTY, the TTY is
automatically opened when I/O is done to it. This is helpful
for allowing C programs to run without the TTY. */
}
/**********************************************************************
VALRET - Valret a String
**********************************************************************/
valret (s) char *s;
{int len, bp1, bp2, buf, c, flag;
flag = FALSE;
len = slen (s);
buf = salloc (len/5 + 1);
if (buf<=0)
{buf=s; /* gross hack */
flag = TRUE;
}
bp1 = bp2 = 0440700000000 | buf;
while (TRUE)
{c = *s++;
if (c=='\n') c='\r';
idpb (c, &bp1);
if (!c) break;
}
val7ret (bp2);
if (flag) cquit(1); else sfree (buf);
}
/**********************************************************************
PRSARG - Parse JCL Arguments (PDP-10 ITS)
given: in - an advance byte pointer to the JCL
out - a pointer to a character buffer where the
arguments should be placed
argv - a pointer to a character pointer array
where pointers to the args should be placed
job - the sixbit XJNAME
narg - the maximum number of arguments
returns: number of arguments
**********************************************************************/
int prsarg (in, out, argv, job, narg)
char *out, *argv[];
{int c, argc;
char *c6tos();
argc = 1;
argv[0] = out;
out = c6tos (job, out);
*out++ = 0;
argv[1] = out;
while (c = ildb (&in))
{switch (c) {
case '\r': break;
case QUOTE: *out++ = ildb (&in); continue;
case ' ': continue;
case '"': while (c = ildb (&in))
{switch (c) {
case '\r': break;
case QUOTE: *out++ = ildb (&in); continue;
case '"': break;
default: *out++ = c; continue;
}
break;
}
*out++ = 0;
if (++argc < narg) argv[argc] = out;
if (c=='"') continue;
break;
default: *out++ = c;
while (c = ildb (&in))
{switch (c) {
case '\r': break;
case ' ': break;
case QUOTE: *out++ = ildb (&in); continue;
default: *out++ = c; continue;
}
break;
}
*out++ = 0;
if (++argc < narg) argv[argc] = out;
if (c==' ') continue;
break;
}
break;
}
return (argc>narg ? narg : argc);
}
/**********************************************************************
CONS - construct word from left and right halves
**********************************************************************/
int cons (lh, rh) {return (((lh & 0777777) << 18) | (rh & 0777777));}
/**********************************************************************
CCTO6 - convert ascii character to sixbit character
**********************************************************************/
char ccto6 (c) char c;
{return (((c>=040 && c<0140) ? c+040 : c) & 077);}
/**********************************************************************
C6TOC - convert sixbit character to ascii character
**********************************************************************/
char c6toc (c) char c;
{return (c+040);}
/**********************************************************************
CSTO6 - convert ascii string to left-justified sixbit
**********************************************************************/
int csto6 (s) char *s;
{int c,i,j;
i=0;
j=30;
while (c = *s++) if (j>=0)
{i =| (ccto6(c)<<j);
j =- 6;
}
return (i);
}
/**********************************************************************
C6TOS - convert left-justified sixbit word to ascii string
**********************************************************************/
char *c6tos (i, p) int i; char *p;
{int c,j;
j = 30;
while (j>=0 && (c = (i>>j)&077))
{*p++ = c6toc(c); j =- 6;}
*p = 0;
return (p);
}
/**********************************************************************
C6Q2S - convert left-justified sixbit word to ascii string,
inserting QUOTE characters, where necessary
**********************************************************************/
char *c6q2s (i, p) int i; char *p;
{int c, j;
j = 30;
while (j>=0)
{c = c6toc ((i>>j) & 077);
if (c==' ' || c==':' || c==';') *p++ = QUOTE;
*p++ = c;
if (! (i & ((1<<j) - 1))) break;
j =- 6;
}
*p = 0;
return (p);
}

719
src/clib/c10job.c Normal file
View File

@@ -0,0 +1,719 @@
# include "clib/c.defs"
# include "clib/its.bits"
/**********************************************************************
JOBs - Inferior Process Management
ITS Version
**********************************************************************/
/*
The representation of a job is an integer with a value from
0 to 7, indicating the inferior number.
Routines:
j_create (jname) => # or error code
j_load (filespec) => # or error code
j_fload (file_name) => # or error code
j_cload (channel, jname) => # or error code
j_own (uname, jname) => # or error code
error code:
-1 unable to open program file
-2 unable to create job
-3 unable to load job
-4 fatal error
-5 (OWN) no such job
-6 (OWN) job not yours
j_start (#) => rc (return code: non-zero => error)
j_stop (#) => rc
j_disown (#) => rc
j_forget (#) => rc
j_kill (#) => rc
j_snarf (#, inferior_name) => rc
(disown named inferior from stopped job)
j_give_tty (#) => rc
j_take_tty (#) => rc
j_grab_tty () (grab tty if given to some inferior
and stop job)
j_retn_tty () (return tty to inferior and restart)
j_wait (#) => status (waits for non-zero status)
j_sts (#) => status
j_onchange (f) (set handler for status changes)
j_sjcl (#, s) => rc (set jcl for job)
j_jcl (#) => s (get jcl)
j_ch (#) => ch (return block image output channel to job)
j_name (#, filespec) (set filespec to job name)
j_val (#) => s (return string valretted by job)
j_fval (#) (flush valret string; or call cfree)
Job Status:
-5 => stopped, ^Z typed
-4 => stopped (by superior)
-3 => stopped, valret
-2 => stopped, requested suicide
-1 => no job
0 => running
>0 => stopped, value is job's first interrupt word
*/
# define MAXJOBS 8
# define VALBUFSIZ 200
/* job status values */
# define js_attn -5
# define js_stopped -4
# define js_valret -3
# define js_suicide -2
# define js_nojob -1
# define js_running 0
/* useful SIXBIT numbers */
/* Fixed by BGS 9/14/79 because of MOVNI bug
# define _USR 0656362000000
# define _TS 0646300000000
# define _DSK 0446353000000
# define _FOO 0465757000000
# define _GR 0360000000000 */ /* > */
#define _USR csto6("USR")
#define _TS csto6("TS")
#define _DSK csto6("DSK")
#define _FOO csto6("FOO")
#define _GR csto6(">")
/* internal tables */
# rename job_channels "JOBCHN"
# rename job_status "JOBSTS"
# rename job_jcl "JOBJCL"
# rename job_valret "JOBVAL"
# rename job_name "JOBNAM"
# rename job_xname "JOBXNM"
# rename job_wait "JOBWAT"
int job_status[MAXJOBS] {js_nojob, js_nojob, js_nojob, js_nojob,
js_nojob, js_nojob, js_nojob, js_nojob};
int job_channels[MAXJOBS] {-1, -1, -1, -1, -1, -1, -1, -1};
char *job_jcl[MAXJOBS];
char *job_valret[MAXJOBS];
int job_name[MAXJOBS];
int job_xname[MAXJOBS];
int job_wait -1;
static int jobtty {-1}, jobotty, jobosts, (*jchandler)();
/* the routines */
int j_fload (file_name) char *file_name;
{filespec f;
fparse (file_name, &f);
return (j_load (&f));
}
int j_load (f) filespec *f;
{int pch, xjname;
if (f->dev == 0) f->dev = _DSK;
if (f->dir == 0) f->dir = rsname ();
pch = mopen (f, BII);
if (pch<0) return (-1);
xjname = (f->fn1 == _TS ? f->fn2 : f->fn1);
return (j_cload (pch, xjname));
}
int j_cload (pch, xjname)
channel pch;
{int j, jch, start;
j = j_create (xjname);
if (j<0)
{close (pch);
return (j);
}
jch = job_channels[j];
/* load program */
if (sysload (jch, pch))
{uclose (jch);
close (pch);
return (-3);
}
/* get starting address of program */
sysread (pch, &start, 1);
close (pch);
/* set starting address of job */
wuset (jch, UPC, start & 0777777);
return (j);
}
int j_create (xjname)
{int jch, i, inc, count, flag;
filespec jf;
/* set up job name */
jf.dev = _USR;
jf.dir = 0;
jf.fn1 = 0;
jf.fn2 = xjname;
/* make job name unique */
flag = FALSE;
while ((jch = open (&jf, OLD + BII)) >= 0)
{close (jch);
if (!flag)
{flag = TRUE;
i = jf.fn2;
count = 0;
while ((i&077)==0) {i =>> 6; ++count;}
if (count>0)
{count = 6*(count-1);
jf.fn2 =| ccto6('0') << count;
inc = 1 << count;
}
else
{jf.fn2 = (jf.fn2 & ~077) | ccto6('0');
inc = 1;
}
}
else jf.fn2 =+ inc;
}
/* create job */
jch = open (&jf, BIO);
if (jch<0) return (-2);
reset (jch);
/* set job's NAMEs */
wuset (jch, USNAME, rsname());
wuset (jch, UXJNAME, xjname);
return (j_xxx (jch, xjname));
}
/**********************************************************************
J_OWN - attach job as inferior
**********************************************************************/
int j_own (uname, jname)
{filespec fs;
int jch, j, w, sts;
fs.dev = _USR;
fs.dir = 0;
fs.fn1 = uname;
fs.fn2 = jname;
if ((jch = open (&fs, OLD + BII)) < 0) return (-5);
close (jch);
if ((jch = open (&fs, BIO)) < 0) return (-5);
if (status (jch) != 061)
{close (jch); return (-6);}
j = j_xxx (jch, jname);
if (ruset (jch, USTOP) & BUSRC)
{w = ruset (jch, UPIRQ);
if (w & PICZ) sts = js_attn;
else if (w & PIVAL) sts = js_valret;
else if (w) sts = w;
else sts = js_stopped;
wuset (jch, UAPIRQ, PJTTY+PIIOC+PIARO+PICZ+PIVAL);
}
else sts = js_running;
job_status[j] = sts;
return (j);
}
/**********************************************************************
J_XXX - common processing for new inferior
**********************************************************************/
int j_xxx (jch, xjname)
{int i, inf_no, option, j_handler();
/* get inferior number */
i = ruset (jch, UINF) >> 18;
inf_no = 0;
if (i) while (!(i&1)) {i=>>1; ++inf_no;}
/* set up interrupt handler */
on (inferior0_interrupt+inf_no, j_handler);
option = ruset (jch, UOPTION);
wuset (jch, UOPTION, option | OPTBRK);
/* clean up */
job_channels[inf_no] = jch;
if (job_status[inf_no] == js_nojob)
{job_status[inf_no] = js_stopped;
job_jcl[inf_no] = 0;
job_valret[inf_no] = 0;
}
job_name[inf_no] = ruset (jch, UJNAME);
job_xname[inf_no] = xjname;
return (inf_no);
}
int j_start (j)
{int ch;
if (j<0 || j>=MAXJOBS) return (-1);
ch = job_channels[j];
if (ch<0) return (-1);
wuset (ch, USTOP, 0);
job_status[j] = js_running;
return (0);
}
int j_stop (j)
{int ch;
if (j<0 || j>=MAXJOBS) return (-1);
ch = job_channels[j];
if (ch<0) return (-1);
wuset (ch, USTOP, -1);
job_status[j] = js_stopped;
return (0);
}
int j_disown (j)
{int ch, ec;
if (j<0 || j>=MAXJOBS) return (-1);
ch = job_channels[j];
if (ch < 0) return (-1);
ec = sysdisown (ch);
if (ec) return (ec);
j_flush (j);
return (0);
}
int j_forget (j)
{int ch;
if (j<0 || j>=MAXJOBS) return (-1);
ch = job_channels[j];
if (ch < 0) return (-1);
close (ch);
j_flush (j);
return (0);
}
int j_kill (j)
{int ch;
if (j<0 || j>=MAXJOBS) return (-1);
ch = job_channels[j];
if (ch<0) return (-1);
uclose (ch);
j_flush (j);
return (0);
}
static int code[] {
0042000000013, /* .IOPUSH 0, ;(26) DON'T CLOBBER HIM */
0041000000034, /* .OPEN 0,34 ;(27) OPEN <JOB> */
0043100000000, /* .LOSE ;(30) FAIL, CAUSE ERR MSG */
0042000000027, /* .DISOWN 0, ;(31) DISOWN <JOB> */
0042000000014, /* .IOPOP 0, ;(32) UNCLOBBER HIM */
0043200000000, /* .VALUE ;(33) RETURN SUCCESS */
0000001656362, /* 1,,'USR ;(34) FILENAME BLOCK */
0, /* ;(35) WILL GET UNAME */
0 /* ;(36) WILL GET JNAME */
};
int j_snarf (j, jname)
{int ch, piclr, pirqc, pc, osts, sts;
if (j<0 || j>=MAXJOBS) return (-1);
osts = job_status[j];
if (osts == js_running) return (-1); /* must be stopped */
ch = job_channels[j];
if (ch<0) return (-1);
code[7] = rsuset (UUNAME);
code[8] = jname;
access (ch, 026);
syswrite (ch, code, 9);
piclr = ruset (ch, UPICLR);
wuset (ch, UPICLR, 0);
pirqc = ruset (ch, UPIRQ);
wuset (ch, UAPIRQ, pirqc);
pc = ruset (ch, UPC);
wuset (ch, UPC, 026);
j_start (j);
sts = j_wait (j);
job_status[j] = osts;
if (sts == js_valret) sts = 0;
else {wuset (ch, UAPIRQ, sts); sts = -1;}
wuset (ch, UPC, pc);
wuset (ch, UIPIRQ, pirqc);
wuset (ch, UPICLR, piclr);
return (sts);
}
int j_flush (j)
{char *p;
job_channels[j] = -1;
job_status[j] = js_nojob;
job_name[j] = 0;
if (p = job_jcl[j])
{sfree (p);
job_jcl[j] = 0;
}
if (p = job_valret[j])
{sfree (p);
job_valret[j] = 0;
}
on (inferior0_interrupt+j, 0);
}
int j_give_tty (j)
{int ch, rc;
if (j<0 || j>=MAXJOBS) return (-1);
ch = job_channels[j];
if (ch<0) return (-1);
rc = atty (ch);
if (rc == 0) jobtty = j;
return (rc);
}
int j_take_tty (j)
{int ch, rc;
if (j<0 || j>=MAXJOBS) return (-1);
ch = job_channels[j];
if (ch<0) return (-1);
rc = dtty (ch);
if (rc == 0) jobtty = -1;
return (rc);
}
int j_grab_tty ()
{if (jobtty >= 0)
{int rc;
jobotty = jobtty;
jobosts = job_status[jobtty];
j_stop (jobtty);
rc = j_take_tty (jobtty);
if (rc && jobosts==0) j_start (jobtty);
return (rc);
}
jobotty = -1;
return (0);
}
int j_retn_tty ()
{if (jobtty < 0 && jobotty >= 0)
{j_give_tty (jobotty);
if (jobosts == 0) j_start (jobotty);
jobotty = -1;
}
}
int j_wait (j)
{int sts;
if (j<0 || j>=MAXJOBS) return (-1);
job_wait = j;
sts = wfnz (&job_status[j]);
job_wait = -1;
return (sts);
}
int j_onchange (f) int (*f)();
{jchandler = f;
}
int j_sts (j)
{if (j<0 || j>=MAXJOBS) return (-1);
return (job_status[j]);
}
int j_sjcl (j, s) char *s;
{char *buf, *p;
int ch, i;
if (j<0 || j>=MAXJOBS) return (-1);
ch = job_channels[j];
if (ch<0) return (-1);
if (*s==0)
{if (buf = job_jcl[j]) /* flush previous */
{i = ruset (ch, UOPTION) & ~OPTCMD;
wuset (ch, UOPTION, i);
sfree (buf);
job_jcl[j] = 0;
}
return (0);
}
i = salloc (slen (s) + 2);
if (i <= 0) return (-1);
buf = i;
stcpy (s, buf);
p = buf;
while (*p) ++p;
if (p==buf || p[-1]!='\r')
{p[0] = '\r';
p[1] = 0;
}
job_jcl[j] = buf;
wuset (ch, UOPTION, OPTCMD);
}
char *j_jcl (j)
{if (j<0 || j>=MAXJOBS) return (0);
return (job_jcl[j]);
}
int j_ch (j)
{if (j<0 || j>=MAXJOBS) return (-1);
return (job_channels[j]);
}
int j_name (j, f) filespec *f;
{f->dev = _USR;
f->dir = 0;
f->fn1 = runame();
if (j>=0 && j<MAXJOBS)
{f->fn2 = job_name[j];
return (f->fn2 == 0);
}
f->fn2 = 0;
return (-1);
}
char *j_val (j)
{if (j<0 || j>=MAXJOBS) return (0);
return (job_valret[j]);
}
j_fval (j)
{if (j<0 || j>=MAXJOBS) return;
if (job_valret[j] == 0) return;
cfree (job_valret[j]);
job_valret[j] = 0;
}
j_handler (j)
{int ch, w, opt, old_status;
if (j<0 || j>=MAXJOBS) return;
ch = job_channels[j];
if (ch<0) return;
old_status = job_status[j];
w = ruset (ch, UPIRQ);
wuset (ch, UAPIRQ, PJTTY+PIIOC+PIARO+PICZ+PIVAL);
opt = ruset (ch, UOPTION);
if ((opt & OPTOPC)==0 && (w & IBACKUP))
wuset (ch, UPC, ruset (ch, UPC) - 1);
job_status[j] = w;
if (w & PICZ) /* ^Z typed */
{job_status[j] = js_attn;
return;
}
if (w & PIVAL) /* .VALUE */
jdovalue (j);
else if (w & PIBRK) /* .BREAK */
jdobrk (j);
if (j != job_wait && job_status[j] != old_status && jchandler)
(*jchandler)(j,job_status[j]);
}
jdovalue (j) /* handle .VALUE */
{int ch, ich, cmda, n;
char *p, buf[VALBUFSIZ];
filespec f;
ch = job_channels[j];
job_valret[j] = 0;
job_status[j] = js_valret;
cmda = ruset (ch, USV40) & 0777777;
if (cmda == 0) return;
if (j_name (j, &f)) return;
if ((ich = open (&f, UII)) < 0) return;
access (ich, cmda);
n = VALBUFSIZ;
p = buf;
while (TRUE)
{int w, i, c;
w = uiiot (ich);
for (i=0;i<5;++i)
{c = (w>>29) & 0177;
w =<< 7;
if (c!='\n') {*p++ = c; --n;}
if (c=='\r') {*p++ = '\n'; --n;}
if (!c) break;
if (n<=2)
{*p++ = c = 0;
break;
}
}
if (!c) break;
}
close (ich);
if (stcmp (buf, ":KILL\r") || stcmp (buf, ":KILL\r\n"))
{/* if (job_wait != j) j_kill (j);
else */ job_status[j] = js_suicide;
return;
}
p = calloc (slen (buf) + 1);
stcpy (buf, p);
job_valret[j] = p;
return;
}
jdobrk (j) /* handle .BREAK */
/* unless there is a 'fatal error', the job status
must be changed to something reasonable */
{int ch, i;
ch = job_channels[j];
wuset (ch, UAPIRQ, PIBRK); /* reset PIRQ bit */
i = ruset (ch, USV40); /* the instruction */
if ((i & ~000740000000) == 042000000033)
i = 045700160000; /* .LOGOUT n, */
switch (i>>18) { /* opcode */
case 045700: /* .BREAK 16 */
/* if ((i & 020000) && (job_wait != j)) j_kill (j);
else */ job_status[j] = js_suicide;
return;
case 045500: /* .BREAK 12 */
jdob12 (j, i);
return;
}
j_start (j);
}
jdob12 (j, i) /* handle .BREAK 12 */
{int cmda, ich, och;
filespec f;
cmda = i & 0777777;
if (j_name (j, &f)) return;
if ((ich = open (&f, UII)) < 0) return;
if ((och = open (&f, UIO)) < 0)
{close (ich);
return;
}
access (ich, cmda);
i = uiiot (ich);
if (i & 0200000000000) /* multiple commands */
{int n, a;
n = (i>>18) | 0777777000000;
a = i & 0777777;
while (n<0)
{access (och, cmda);
++n;
++a;
uoiot (och, (n<<18) | a);
access (ich, a-1);
do_brk (j, ich, och, uiiot (ich));
}
}
else do_brk (j, ich, och, i);
close (ich);
close (och);
j_start (j);
}
do_brk (j, ich, och, w) /* do .BREAK 12 command W */
{int cmd, a, f, i;
cmd = (w>>18) & 0177777;
a = w & 0777777;
access (och, a);
if (cmd==6) /* send :PRINT defaults */
{uoiot (och, _DSK);
uoiot (och, rsname ());
uoiot (och, _FOO);
uoiot (och, _GR);
return;
}
if (cmd==5 && job_jcl[j])
{f = copen (job_jcl[j], 'r', "s");
access (ich, a+2);
while (TRUE)
{w = 0;
for (i=0;i<5;++i) w = (w<<7) | (cgetc (f) & 0177);
w =<< 1;
uoiot (och, w);
if ((w & 0377) == 0) break;
if (uiiot (ich))
{uoiot (och, 0);
break;
}
}
cclose (f);
return;
}
if (cmd==10) /* send XJNAME */
{uoiot (och, job_xname[j]);
return;
}
}

57
src/clib/c10map.c Normal file
View File

@@ -0,0 +1,57 @@
/*
FILMAP - file mapping routines
filmap (c, o, s) map in part of a file
filunmap (p, s) unmap part of a file
*/
# include "c.defs"
/**********************************************************************
FILMAP - map in a part of a disk file
return a pointer to it
**********************************************************************/
int *filmap (ch, offset, size)
{int block_no, page_no, word_no, no_pages, i;
int *p;
block_no = offset>>10;
word_no = offset & 01777;
no_pages = ((word_no + size - 1) >> 10) + 1;
page_no = pg_get (no_pages);
if (page_no < 0)
{puts ("FILMAP: Unable to Allocate Pages.\n");
return (0);
}
for (i=0;i<no_pages;++i)
if (corblk (0600000, -1, page_no+i, ch, block_no+i))
{cprint ("FILMAP: Error In Mapping Page %d.\n", block_no+i);
break;
}
p = (page_no<<10)+word_no;
return (p);
}
/**********************************************************************
FILUNMAP - Unmap pages mapped by FILMAP
**********************************************************************/
filunmap (p, size) int *p;
{int page_no, word_no, no_pages, p_rep;
p_rep = p;
word_no = p_rep & 01777;
page_no = p_rep >> 10;
no_pages = ((word_no + size - 1) >> 10) + 1;
pg_ret (page_no, no_pages);
}

489
src/clib/c10mio.cmid Normal file
View File

@@ -0,0 +1,489 @@
;
; C10MIO - C I/O ROUTINES WRITTEN IN MIDAS
;
; This file is ITS dependent.
;
TITLE MIO
.INSRT NC
.INSRT NM
; INCLUDES:
;
; CGETC - CIO GET CHARACTER
; CPUTC - CIO PUT CHARACTER
; CGETI - CIO GET INTEGER (IMAGE)
; CPUTI - CIO PUT INTEGER (IMAGE)
; CEOF - CIO TEST FOR END-OF-FILE
; CFLUSH - CIO FLUSH BUFFER
; REW - REWIND INPUT FILE
; CLOSALL - CIO CLOSE ALL FILES
; CCLOSE - CIO CLOSE FILE
; ISTTY - IS FILE A TTY?
; CISFD - IS PTR AN ACTUAL FILE DESCRIPTOR?
; ITSCHAN - RETURN ACTUAL ITS CHANNEL
;
; REGISTERS
FP==3 ; FILE CONTROL BLOCK POINTER
T1==4 ; TEMPORARY
; VALUES
NL==12
CR==15
; FILE CONTROL BLOCK ENTRIES
FBUFFP==0 ; (LEFT HALF) POINTER TO BUFFER (OR ZERO IF NOT BUFFERED)
FCHAN: 160400,,(FP) ; ITS CHANNEL NUMBER
FDEVIC: 100600,,(FP) ; DEVICE CODE
FFLAG==0 ; (RIGHTMOST 8 BITS) FLAGS
PHYEOF==1 ; PHYSICAL EOF REACHED (BUFFERED INPUT)
%OPEN==2 ; FILE IS OPEN
%WRITE==4 ; FILE IS OPEN FOR WRITE
%TTY==10 ; FILE IS TTY
%UNSET==20 ; DEVICE AND CHANNEL NOT SET YET
FBPTR==1 ; POINTER TO NEXT CHAR/WORD OR CHAR/WORD POSITION
FBCNT==2 ; NUMBER OF CHARS/WORDS OR AVAILABLE POSITIONS IN BUFFER
FUCNT==3 ; (LEFT HALF) NUMBER OF CHARS IN UNGETC BUFFER
FUPTR==3 ; (RIGHT HALF) POINTER TO UNGETC BUFFER
FCLSR==4 ; (LEFT HALF) ADDRESS OF CLOSE ROUTINE
FNGETR==4 ; (RIGHT HALF) ADDRESS OF NORMAL GETC ROUTINE
FGETCR==5 ; ADDRESS OF CGETC ROUTINE
FPUTCR==6 ; ADDRESS OF CPUTC ROUTINE
FCBSIZ==7 ; SIZE OF FILE CONTROL BLOCK
; CONSTANTS
IBFSIZ==200
NCHAN==10.
UBFFSZ==20.
CENTRY CGETC,[FD]
XENTRY GETC,CGETC
XENTRY CGETI,CGETC
XENTRY GETI,CGETC
HRRZ FP,FD ; FILE DESCRIPTOR
GO @FGETCR(FP) ; JUMP TO APPROPRIATE ROUTINE
GETBUF: SOSGE FBCNT(FP) ; HERE FOR BUFFERED CHAR INPUT
JSP B,GTBUF1 ; BUFFER EMPTY, GO FILL IT
ILDB A,FBPTR(FP) ; GET NEXT CHAR FROM BUFFER
CAIN A,CR ; IGNORE INCOMING CR
GO GETBUF
RETURN
GETBIN: SOSGE FBCNT(FP) ; HERE FOR BINARY INPUT
GO GTBIN1 ; BUFFER EMPTY, REFILL IT
MOVE A,@FBPTR(FP) ; GET NEXT WORD FROM BUFFER
AOS FBPTR(FP) ; INCR POINTER
RETURN
GETSTR: MOVE A,@FBPTR(FP) ; HERE FOR STRING INPUT
AOS FBPTR(FP) ; INCR POINTER
JUMPE A,NEWEOF
RETURN
GETTTY: CALL TYI ; HERE FOR TTY INPUT
HRRZ FP,FD ; RESTORE FP
JUMPE A,NEWEOF
RETURN
IENTRY GC$BAD
CROAK BAD CALL TO CGETC/CGETI
SETO A,
RETURN
GETUN: HLRZ B,FUCNT(FP) ; HERE WHEN CHAR IN UNGETC BUFFER
JUMPLE B,CODE [ ; IS UNGETC BUFFER EMPTY?
HRRZ A,FNGETR(FP) ; YES
MOVEM A,FGETCR(FP) ; RESTORE CGETC ROUTINE
GO (A) ; GET NEXT CHAR
]
HRRZ A,FUPTR(FP)
ADD A,B
HRRZ A,(A) ; GET CHAR
SUBI B,1 ; DECR COUNT
HRLM B,FUCNT(FP)
RETURN
NEWEOF: MOVEI A,EOF ; HERE ON NEWLY DISCOVERED EOF
MOVEM A,FGETCR(FP)
HRRM A,FNGETR(FP) ; SET CGETC ROUTINE TO EOF
EOF: SETZ A,
RETURN
; BUFFERED CHARACTER INPUT - BUFFER READ ROUTINE
;
; CONTAINS HACKERY WHICH ALLOWS DETECTION OF LAST WORD
; OF FILE. TRAILING CONTROL-C'S ARE REMOVED FROM THIS
; WORD. CALLED VIA JSP B,
;
GTBUF1: HRRZ T1,FFLAG(FP) ; HERE TO FILL OR REFILL BUFFER
TRNE T1,PHYEOF ; HAS END OF FILE BEEN REACHED?
GO NEWEOF ; YES, ANNOUNCE IT
MOVN A,FBCNT(FP) ; OLD CHARACTER COUNT (CHECKED LATER)
MOVEI T1,5*<IBFSIZ-1> ; RESET CHARACTER COUNT
MOVEM T1,FBCNT(FP) ; (LAST WORD SAVED FOR NEXT BUFFER)
HLRZ T1,FBUFFP(FP) ; RESET CHARACTER POINTER
HRLI T1,440700 ; TO BEGINNING OF BUFFER
MOVEM T1,FBPTR(FP)
CAIE A,2 ; CHECK OLD COUNT FOR SPECIAL VALUE
GO GTBUF2 ; NORMAL (NOT INIT) CASE
HLRZ T1,FBUFFP(FP) ; FIRST TIME - FILL ENTIRE BUFFER
HRLI T1,-IBFSIZ
GO GTBUF3
GTBUF2: HLRZ T1,FBUFFP(FP) ; NORMAL CASE - ONE WORD SAVED FROM LAST READ
MOVE A,IBFSIZ-1(T1) ; GET LAST WORD OF BUFFER (UNREAD)
MOVEM A,(T1) ; MAKE FIRST WORD OF BUFFER
ADDI T1,1 ; ADJUST CPTR TO FILL REST OF BUFFER
HRLI T1,-IBFSIZ+1
GTBUF3: LDB A,FCHAN ; ITS CHANNEL NUMBER
LSH A,23.
IOR A,[.IOT T1]
XCT A ; EXECUTE .IOT
JUMPGE T1,-2(B) ; BUFFER WAS FILLED, NO MORE TO DO
HLRES T1
ADDI T1,IBFSIZ ; NUMBER OF WORDS READ
HLRZ A,FBUFFP(FP)
ADDI A,-1(T1) ; POINTER TO WORD LAST READ
IMULI T1,5 ; NUMBER OF CHARS READ
PPUSH B
MOVEI B,5 ; CHECK FOR AT MOST 5 TRAILING ^C'S
HRLI A,010700 ; BYTE POINTER TO LAST CHAR
GTBUF4: LDB 0,A ; GRAB CHARACTER
ADD A,[070000,,0] ; DECREMENT BYTE POINTER
CAIE 0,3 ; IS IT A ^C
GO GTBUF5 ; NO
SUBI T1,1 ; DECREMENT CHARACTER COUNT
SOJG B,GTBUF4 ; KEEP LOOKING
GTBUF5: PPOP B
MOVEM T1,FBCNT(FP) ; SET CHARACTER COUNT
MOVEI T1,PHYEOF
IORM T1,FFLAG(FP) ; SET PHYSICAL EOF FLAG
GO -2(B) ; THAT'S IT!
;
; GTBIN1 - INTERNAL CODE FOR BINARY BUFFER GET
;
GTBIN1: HRRZ T1,FFLAG(FP) ; HERE TO REFILL BUFFER IN BINARY MODE
TRNE T1,PHYEOF ; HAS END OF FILE BEEN REACHED?
GO NEWEOF ; YES, ANNOUNCE IT
MOVEI T1,IBFSIZ
MOVEM T1,FBCNT(FP) ; RESET COUNTER
HLRZ T1,FBUFFP(FP) ; BUFFER POINTER
MOVEM T1,FBPTR(FP) ; RESET POINTER
HRLI T1,-IBFSIZ ; COUNTING POINTER FOR IOT
LDB A,FCHAN
LSH A,23.
IOR A,[.IOT T1] ; SET UP .IOT INSTRUCTION
XCT A ; EXECUTE .IOT INSTRUCTION
JUMPGE T1,GETBIN ; BUFFER WAS FILLED, RESUME
HLRES T1
ADDI T1,IBFSIZ ; NUMBER OF WORDS ACTUALLY READ
MOVEM T1,FBCNT(FP) ; SET COUNTER
MOVEI T1,PHYEOF
IORM T1,FFLAG(FP) ; SET PHYSICAL EOF FLAG
GO GETBIN ; RESUME
CENTRY CPUTC,[CC,FD]
XENTRY PUTC,CPUTC
XENTRY CPUTI,CPUTC
XENTRY PUTI,CPUTC
HRRZ FP,FD ; FILE DESCRIPTOR
MOVE A,CC ; CHARACTER (OR INTEGER) TO BE WRITTEN
GO @FPUTCR(FP) ; JUMP TO APPROPRIATE ROUTINE
PUTBUF: CAIN A,NL ; HERE FOR BUFFERED CHAR OUTPUT
GO CODE [
CALL CPUTC,[[[CR]],FP]
HRRZ FP,FD
MOVEI A,NL
GO PF$1
]
JUMPE A,PC$RET ; DONT WRITE NULLS
PF$1: IDPB A,FBPTR(FP) ; STORE CHAR
SOSG FBCNT(FP) ; BUFFER FULL?
GO CODE [ ; YES
MCALL FLUSHB,[FP,[[IBFSIZ]]] ; FLUSH ENTIRE BUFFER
GO PC$RET
]
PC$RET: RETURN ; NO, RETURN
PUTBIN: MOVEM A,@FBPTR(FP) ; HERE ON BINARY OUTPUT
AOS FBPTR(FP)
SOSLE FBCNT(FP)
GO PC$RET
HLRZ T1,FBUFFP(FP)
HRLI T1,-IBFSIZ ; SET UP COUNTING POINTER FOR .IOT
LDB A,FCHAN ; GET ITS CHANNEL NUMBER
LSH A,23.
IOR A,[.IOT T1] ; PREPARE .IOT INSTRUCTION
XCT A ; EXECUTE .IOT INSTRUCTION
MOVEI T1,IBFSIZ
MOVEM T1,FBCNT(FP) ; RESET COUNTER
HLRZ T1,FBUFFP(FP)
MOVEM T1,FBPTR(FP) ; RESET POINTER
GO PC$RET
PUTSTR: MOVEM A,@FBPTR(FP) ; HERE ON STRING OUTPUT
AOS FBPTR(FP)
GO PC$RET
PUTTTY: CAIN A,NL ; HERE ON TTY OUTPUT
MOVEI A,CR ; OUTPUT NEWLINES AS CR'S
CALL TYO,[A]
GO PC$RET
IENTRY PC$BAD
CROAK BAD CALL TO CPUTC/CPUTI
SETO A,
GO PC$RET
CENTRY CEOF,[FD]
HRRZ FP,FD
SETZ A,
HRRZ B,FGETCR(FP)
CAIN B,EOF
MOVEI A,1
CAIN B,GC$BAD
SETO A,
RETURN
CENTRY UNGETC,[CC,FD]
HRRZ FP,FD ; FILE DESCRIPTOR
MOVE A,CC ; CHARACTER
HLRZ T1,FUCNT(FP) ; NUMBER OF CHARS IN BUFFER
ADDI T1,1
CAIL T1,UBFFSZ ; TOO MANY?
GO CODE [
SETO A,
GO UN$RET
]
HRLM T1,FUCNT(FP)
HRRZ B,FUPTR(FP)
ADD T1,B
MOVEM A,(T1) ; STORE CHAR
MOVEI B,GETUN
MOVEM B,FGETCR(FP) ; SET UP GETC ROUTINE
UN$RET: RETURN
CENTRY CFLUSH,[FD]
MCALL FLUSHP,[FD,[[0]]]
RETURN
MENTRY FLUSHP,[FD,PADC]
HRRZ FP,FD
HRRZ A,FPUTCR(FP) ; OUTPUT ROUTINE
CAIE A,PUTBUF
GO FL$RET
HRRZ T1,PADC ; PAD CHARACTER
MOVEI A,5*IBFSIZ ; NUMBER OF CHAR POSITIONS
SUB A,FBCNT(FP) ; NUMBER OF ACTUAL CHARS IN BUFFER
JUMPLE A,FL$RET ; BUFFER IS EMPTY
IDIVI A,5
JUMPE B,FL$1 ; NO PARTIALLY FILLED WORDS
MOVN B,B
ADDI B,5
IDPB T1,FBPTR(FP) ; FILL OUT WITH ^C'S
SOJG B,.-1
ADDI A,1
FL$1: MCALL FLUSHB,[FP,A]
FL$RET: RETURN
MENTRY FLUSHB,[FD,SIZE]
MOVE FP,FD ; FILE POINTER
MOVN T1,SIZE ; SIZE OF FILLED PART OF BUFFER
HRLZ T1,T1 ; CONSTRUCT
HLR T1,FBUFFP(FP) ; .IOT POINTER
LDB B,FCHAN
LSH B,23.
IOR B,[.IOT T1] ; PREPARE .IOT INSTRUCTION
XCT B ; EXECUTE .IOT INSTRUCTION
MOVEI T1,5*IBFSIZ
MOVEM T1,FBCNT(FP) ; RESET COUNTER
HLRZ T1,FBUFFP(FP)
HRLI T1,440700
MOVEM T1,FBPTR(FP) ; RESET ABPTR
RETURN
CENTRY REW,[FD]
HRRZ FP,FD
SETOM FBCNT(FP)
HRRZ A,FFLAG(FP)
TRZ A,PHYEOF
HRRM A,FFLAG(FP)
MOVE A,GETTAB+1
MOVEM A,FGETCR(FP)
LDB A,FCHAN
.CALL [SETZ ? 'ACCESS ? A ? 401000,,0]
CROAK REW: ACCESS FAILED
RETURN
CENTRY CLOSALL,,[COUNTER] ; CLOSE ALL C FILES
MOVEI A,NCHAN-1
MOVEM A,COUNTER
MOVE A,COUNTER
CA$1: CALL CCLOSE,[FCBTBL(A)]
SOSL A,COUNTER
GO CA$1
RETURN
CENTRY CCLOSE,[FD]
HRRZ FP,FD
HLRZ A,FCLSR(FP)
GO (A) ; JUMP TO APPROPRIATE ROUTINE
CLOBUF: MCALL FLUSHP,[FP,[[3]]]
GO CLIBUF
CLOBIN: MOVE A,FBCNT(FP) ; HERE ON BINARY OUTPUT
SUBI A,IBFSIZ
JUMPGE A,CLIBUF
HRLZ A,A
HLR A,FBUFFP(FP)
LDB B,FCHAN
LSH B,23.
IOR B,[.IOT A]
XCT B ; FLUSH BUFFER
CLIBUF: LDB A,FCHAN ; HERE ON BUFFERED AND BINARY INPUT
; ALSO FALL THROUGH FROM BUFFERED AND BINARY OUTPUT
CALL MCLOSE,[A]
MOVE FP,FD
CLTTY: SETZ A, ; HERE ON TTY AND FALL THROUGH
CLOSE2: MOVEI T1,%OPEN ; HERE TO CLEAR %OPEN BIT
ANDCAM T1,FFLAG(FP)
MOVEI T1,GC$BAD ; SET ROUTINES TO BAD
MOVEM T1,FGETCR(FP)
MOVEI T1,PC$BAD
MOVEM T1,FPUTCR(FP)
MOVE T1,[CL$BAD,,GC$BAD]
MOVEM T1,FCLSR(FP)
CL$RET: RETURN
CLOSTR: MOVE A,FBPTR(FP) ; HERE ON STRING OUTPUT
SETZM (A) ; APPEND NULL ONTO STRING
GO CLOSE2 ; RETURN POINTER TO NULL CHAR
IENTRY CL$BAD
SETO A,
GO CL$RET
CENTRY ISTTY,[FD]
HRRZ FP,FD
HRRZ A,FFLAG(FP)
TRNE A,%UNSET ; IS DEVICE CODE VALID?
GO IS$RET ; NO -- MUST BE A TTY
LDB A,FDEVICE ; GET IT
CAILE A,2 ; TEST FOR TTY DEVICES
SETZ A,
IS$RET: RETURN
; INTERNAL ROUTINE TO SET DEVICE AND CHANNEL
; MUST BE THE TTY INPUT OR OUTPUT CHANNEL
; RETURN DEVICE CODE
MENTRY SETDEV,[FD]
HRRZ FP,FD
MOVE A,FFLAG(FP)
TRNE A,%WRITE
MOVEI B,ZTYOOPN"
TRNN A,%WRITE
MOVEI B,ZTYIOPN"
VCALL (B)
JUMPL A,SD$RET ; VALID CHANNEL RETURNED?
HRRZ FP,FD
DPB A,FCHAN ; YES - STORE IT
LSH A,23.
IOR A,[.STATUS A]
XCT A
ANDI A,77 ; GET DEVICE FROM CHANNEL STATUS
DPB A,FDEVIC ; STORE DEVICE
MOVEI T1,%UNSET ; CLEAR %UNSET BIT
ANDCAM T1,FFLAG(FP)
SD$RET: RETURN
CENTRY CISFD,[FD]
MOVE A,FD
CAIGE A,C0FCBS+1
GO ISF$NO
CAIL A,C0FCBS+1+NCHAN*FCBSIZ
GO ISF$NO
MOVEI A,1
RETURN
ISF$NO: SETZ A,
RETURN
CENTRY ITSCHAN,[FD]
HRRZ FP,FD
HRRZ A,FFLAG(FP)
TRNN A,%UNSET ; IS CHANNEL CODE VALID?
GO IC$1 ; YES - GET IT
MCALL SETDEV,[FD] ; NO -- SET IT AND RETURN IT
RETURN
IC$1: LDB A,FCHAN ; GET CHANNEL
RETURN
.PDATA
MDATA GETTAB
GETTTY
GETBUF
GETBIN
GETSTR
GC$BAD
GC$BAD
GC$BAD
GC$BAD
MDATA PUTTAB
PC$BAD
PC$BAD
PC$BAD
PC$BAD
PUTTTY
PUTBUF
PUTBIN
PUTSTR
MDATA CLOTAB
CLTTY
CLIBUF
CLIBUF
CLTTY
CLTTY
CLOBUF
CLOBIN
CLOSTR
; STATIC DATA AREAS
.UDATA
MDATA C0FCBS
BLOCK NCHAN*FCBSIZ+1
MDATA FCBTBL
REPEAT NCHAN C0FCBS+1+.RPCNT*FCBSIZ
END

110
src/clib/c10pag.c Normal file
View File

@@ -0,0 +1,110 @@
/*
* C PAGE Handling Package
*
* routines:
*
* pg = pg_get (n)
* rc = pg_ret (pg, n)
* b = pg_exist (pg)
* i = pg_nshare (pg)
* i = pp_nshare (p)
*
*/
# include "c.defs"
# rename page_table "PAGTAB"
# rename first_free_page "FFPAGE"
int first_free_page;
extern int page_table [256];
extern int cerr;
/**********************************************************************
PG_GET - Page Get
Allocate "n" contiguous unused pages in the address space.
Return the number of the lowest page allocated, or -1
if unable to allocate pages.
**********************************************************************/
int pg_get (n)
{int page, i, top, tp, n_free;
if (n<1 || n>254) return (-1);
page = first_free_page; /* first page we examine */
top = 256-n; /* highest possible low page */
n_free = 0; /* number of free pages we see */
while (page <= top)
{for (i=0;i<n;++i)
{tp = page+i;
if (page_table[tp]!=0 || pg_exist(tp)) break;
else ++n_free;
}
if (i>=n) break; /* success */
page =+ i+1;
}
if (page > top) return (-1);
for (i=0;i<n;++i) page_table[page+i] = -1;
if (n_free==n) first_free_page = page+n;
return (page);
}
/**********************************************************************
PG_RET - Page Return
deallocate "n" pages in the address space and unmap them
return non-zero on error
**********************************************************************/
int pg_ret (page, n)
{if (n<1 || page<=0 || page+n>256)
{cprint (cerr, "PG_RET: invalid page number %d.\n", page);
return (-1);
}
if (page < first_free_page) first_free_page = page;
while (--n >= 0)
{page_table[page] = 0;
corblk (0, -1, page, -1, page);
++page;
}
return (0);
}
/**********************************************************************
PG_EXIST - Does page exist in address space?
**********************************************************************/
pg_exist (page_no)
{int blk[4];
cortyp (page_no, blk);
return (page_table[page_no] = (blk[0] != 0));
}
/**********************************************************************
PG_NSHARE - Return number of times page is shared
**********************************************************************/
pp_nshare (p) {return (pg_nshare (p>>10));}
pg_nshare (page_no)
{int blk[4];
cortyp (page_no, blk);
return (blk[3] & 0777777);
}

430
src/clib/c10run.cmid Normal file
View File

@@ -0,0 +1,430 @@
;
; C10RUN - BASIC C RUN-TIME SUPPORT
;
; This file is ITS dependent.
;
TITLE CRUN
.INSRT NC
.INSRT NM
.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
IENTRY FIXIFY
JUMPL A,FIXL
FADR A,[.499999]
UFA A,[233000000000']
TLZ B,777000'
JRST @0
FIXL: MOVN A,A
FADR A,[.499999]
UFA A,[233000000000']
TLZ B,777000'
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

43
src/clib/c10sav.cmid Normal file
View File

@@ -0,0 +1,43 @@
;
; CSAVE - Routine to prepare for saving a program file
;
; This file is ITS dependent.
; This file contains the size of the shared library file.
;
TITLE CSAVE
.INSRT NC
.INSRT NM
.GLOBAL TYICHN,TYOCHN,PDLBOT,PDLTOP
CENTRY CSAVE
SETOM TYICHN
SETOM TYOCHN
MOVE A,[-10.,,246.]
.CALL [SETZ ? 'CORBLK ? MOVEI 0 ? MOVEI %JSELF ? SETZ A]
; DELETE SHARED LIBRARY PAGES
CROAK CORBLK FAILED
; DELETE STACK PAGES
MOVE A,PDLBOT
ADDI A,1777
TRZ A,1777 ; MOVE TO NEXT PAGE BOUNDARY
MOVE B,PDLTOP ; LAST WORD OF STACK
ADDI B,1
TRZ B,1777 ; MOVE TO PREVIOUS PAGE BOUNDARY
LSH A,-10.
LSH B,-10. ; GET PAGE NUMBERS
SUB B,A ; NUMBER OF PAGES
MOVN B,B ; NEGATIVE NUMBER OF PAGES
HRL A,B ; MAKE COUNTING POINTER
.CALL [SETZ ? 'CORBLK ? MOVEI 0 ? MOVEI %JSELF ? SETZ A]
CROAK CORBLK FAILED
.VALUE [ASCIZ/:PDUMP /]
RETURN
END

24
src/clib/c10sfd.c Normal file
View File

@@ -0,0 +1,24 @@
/**********************************************************************
SETFDIR - Set File Directory (and defaults)
(obsolete)
**********************************************************************/
char *setfdir (buf, name, dir)
char *buf, *name, *dir;
{filespec fs1, fs2;
char *p;
fparse (name, &fs1);
fparse (dir, &fs2);
if (fs2.dir==0) fs2.dir=fs2.fn1;
if (fs2.dev) fs1.dev = fs2.dev;
else if (fs1.dev==0) fs1.dev=csto6("dsk");
if (fs2.dir) fs1.dir = fs2.dir;
else if (fs1.dir==0) fs1.dir=rsname();
p = prfile (&fs1, buf);
*p = 0;
return (buf);
}

63
src/clib/c10sry.cmid Normal file
View File

@@ -0,0 +1,63 @@
;
; C10SRY - CHANGE .VCALL'S TO PUSHJ'S
;
; This file is ITS dependent.
; This routine assumes a superior DDT.
;
TITLE SORRY
.INSRT NC
.INSRT NM
.GLOBAL SEG2LO,SEG2HI,SEG3LO,SEG3HI
IENTRY SORRY
.VALUE [ASCIZ/:UNPURE
P/]
; 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$IMPR
; .VALUE
SKIPA A,SEG2LO ; POINTER TO BEGINNING OF CODE AREA
S1: ADDI A,1 ; NEXT WORD
CAML A,SEG2HI ; AT END OF CODE AREA?
GO DONE
HLRZ B,(A) ; INSTRUCTION
TRZ B,000777 ; ISOLATE OPCODE
CAIE B,(.VCALL) ; IS IT A .CCALL?
GO S1 ; NO, GO ON
HLRZ B,(A) ; THE INSTRUCTION AGAIN
TRZ B,777740 ; FLUSH OPCODE AND ACCUMULATOR
IORI B,(PUSHJ P,) ; MAKE IT A PUSHJ
HRLM B,(A) ; STORE IT
GO S1
DONE: MOVE A,SEG2LO
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$PURE
.VALUE
.VALUE [ASCIZ/:PDUMP /]
.BREAK 16,0
.PDATA
I$PURE: SETZ ? 'CORBLK ? 1000,,%CBNDR ? 1000,,%JSELF ? 400000,,A
;I$IMPR: SETZ ? 'CORBLK ? 1000,,%CBRED+%CBWRT ? 1000,,%JSELF ? 400000,,A
END

135
src/clib/c10std.c Normal file
View File

@@ -0,0 +1,135 @@
# include "c.defs"
# include "stdio.h"
/**********************************************************************
STDIO.C - 'Standard I/O' Simulator for ITS
Must call STDIO to initialize.
**********************************************************************/
int *stdin, *stdout, *stderr;
extern int cin, cout, cerr;
stdio ()
{stdin = cin; stdout = cout; stderr = cerr;
on (ctrlg_interrupt, INT_IGNORE);
}
flopen (name, mode)
char *name, *mode;
{int f;
f = copen (name, mode[0]);
if (f == OPENLOSS) return (0);
return (f);
}
int fgetc (f)
{int c;
c = cgetc (f);
if (c < 0) return (EOF);
if (c == 0 && ceof (f)) return (EOF);
return (c);
}
int fgeth ()
{return (fgetc (cin));}
int peekc (f)
{int c;
c = cgetc (f);
if (c < 0) return (EOF);
if (c == 0 && ceof (f)) return (EOF);
ungetc (c, f);
return (c);
}
int pkchar ()
{return (peekc (cin));}
printf (a, b, c, d, e, f, g)
{cprint (cout, a, b, c, d, e, f, g);}
fprintf (a, b, c, d, e, f, g)
{cprint (a, b, c, d, e, f, g);}
fclose (f) {cclose (f);}
fread (f, buf, size, number) char buf[];
{int n;
n = size * number;
while (--n >= 0) *buf++ = cgetc (f);
}
freopen (name, mode, f) char *name, *mode;
{int i;
cclose (f);
i = copen (name, *mode);
return (i);
}
/**********************************************************************
STRING ROUTINES
**********************************************************************/
strcmp (s1, s2)
char *s1, *s2;
{int c1, c2;
while (TRUE)
{c1 = *s1++;
c2 = *s2++;
if (c1 < c2) return (-1);
if (c1 > c2) return (1);
if (c1 == 0) return (0);
}
}
strcpy (dest, source)
char *dest, *source;
{stcpy (source, dest);}
strcat (dest, source)
char *dest, *source;
{while (*dest) ++dest;
stcpy (source, dest);
}
getuid () {return (rsuset (074));}
getpw (w, buf) char *buf;
{c6tos (w, buf);}
nowtime (tv) int tv[];
{cal foo;
now (&foo);
tv[0] = tv[1] = cal2f (&foo);
}
char *ctime (tv) int tv[];
{static char buf[100];
cal foo;
int f;
f2cal (tv[0], &foo);
f = copen (buf, 'w', "s");
prcal (&foo, f);
cputc ('\n', f);
cclose (f);
return (buf);
}
unlink (s) {delete (s);}
exit (cc) {cexit (cc);}

727
src/clib/c10sys.cmid Normal file
View File

@@ -0,0 +1,727 @@
;
; C10SYS - C LIBRARY ROUTINES (INTERFACES TO SYSTEM CALLS)
;
; This file is ITS dependent.
;
TITLE C10SYS
.INSRT NC
.INSRT NM
; CONTAINS:
; SYSOPEN ; OPEN CHANNEL
; CLOSE ; CLOSE CHANNEL
; CHNLOC ; FIND AVAILABLE CHANNEL
; UIIOT ; PERFORM UNIT INPUT IOT
; UOIOT ; PERFORM UNIT OUTPUT IOT
; SYSREAD ; PERFORM BLOCK INPUT IOT
; SYSWRITE ; PERFORM BLOCK OUTPUT IOT
; SIOT ; STRING IOT
; SYSFINISH ; FORCE OUTPUT AND WAIT FOR COMPLETION
; SYSFORCE ; FORCE OUTPUT TO DEVICE
; RESET ; RESET CHANNEL
; STATUS ; GET CHANNEL STATUS
; RFPNTR ; READ FILE ACCESS POINTER
; ACCESS ; PERFORM RANDOM ACCESS ON CHANNEL
; FILLEN ; GET FILE LENGTH
; FILNAM ; GET FILE NAME FROM CHANNEL
; RAUTH ; READ FILE AUTHOR
; SAUTH ; SET FILE AUTHOR
; RDMPBT ; READ DUMP BIT
; SDMPBT ; SET DUMP BIT
; SREAPB ; SET DO-NOT-REAP BIT
; RFDATE ; READ FILE CREATION DATE
; SFDATE ; SET FILE CREATION DATE
; SRDATE ; SET FILE REFERENCE DATE
; DSKUPD ; UPDATE FILE INFO
; RESRDT ; RESTORE FILE INFO
; TTYGET ; GET TTY STATUS
; TTYSET ; SET TTY STATUS
; CNSGET ; GET CONSOLE PARAMETERS
; CNSSET ; SET CONSOLE PARAMETERS
; ITYIC ; READ TTY INTERRUPT CHARACTER
; WHYINT ; WHY WAS I INTERRUPTED?
; SYSLISTEN ; LISTEN FOR TTY INPUT
; RCPOS ; READ CURSOR POSITION
; SCML ; SET # OF COMMAND LINES
; GETCPU ; RETURN CPU TIME IN 4.069 USEC
; CPUTM ; RETURN CPU TIME IN 1/60 SECONDS
; SLEEP ; GO TO SLEEP
; ETIME ; RETURN A TIME FOR ELAPSED TIME MEASUREMENT
; NOW ; GET CURRENT DATE AND TIME
; CORBLK ; PERFORM PAGE HACKING
; CORTYP ; GET INFORMATION ABOUT PAGE
; PAGEID ; GET NAMED PUBLIC PAGE
; PGWRIT ; CAUSE PAGE TO BE WRITTEN ON DISK
; RSNAME ; READ SNAME
; SSNAME ; SET SNAME
; RUNAME ; READ USER NAME
; RSUSET ; WHAT = RSUSET (WHERE)
; WSUSET ; WHAT = WSUSET (WHERE, WHAT)
; RUSET ; WHAT = RUSET (WHO, WHERE)
; WUSET ; WHAT = WUSET (WHO, WHERE, WHAT)
; WUSRVAR ; RC = WUSRVAR (JOB, SPEC, VALUE)
; DELETE ; DELETE A FILE
; SYSDEL ; DELETE FILE
; RENMWO ; RENAME FILE OPEN FOR OUTPUT
; SYSRNM ; EC = SYSRNM (FS1, FS2)
; SYSLNK ; EC = MAKE LINK (FS1, FS2)
; DIRSIZ ; READ DIRECTORY SIZE, QUOTA INFO
; TRANAD ; RC = TRANAD (JOB, FROM, TO, FLAGS)
; TRANCL ; RC = TRANCL (JOB, FLAGS)
; TRANDL ; RC = TRANDL (JOB, FILESPEC, FLAGS)
; SYSLOAD ; LOAD A PROGRAM
; PDUMP ; PDUMP A PROGRAM
; UCLOSE ; DESTROY INFERIOR JOB
; SYSDISOWN ; EC = SYSDISOWN (JOBCH)
; REOWN ; EC = REOWN (JOBCH)
; SYSDTACH ; EC = SYSDTACH (JOBCH)
; SYSATACH ; EC = SYSATACH (JOBCH, TTY)
; ATTY ; GIVE TTY TO INFERIOR
; DTTY ; TAKE TTY FROM INFERIOR
; WFNZ ; WAIT FOR WORD TO BECOME NON-ZERO
; WFZ ; WAIT FOR WORD TO BECOME ZERO
; VAL7RET ; VALRET AN ASCIZ STRING
; DEMSIG ; SIGNAL A DEMON PROCESS
; SSTATUS ; OBTAIN SYSTEM STATUS
; MAKTAG ; CREATE A TAG (GLOBAL LABEL)
; GOTAG ; GOTO A TAG, DISMISSING INTERRUPTS
CENTRY SYSOPEN,[CHAN, FILSPC, MODE] ; OPEN CHANNEL
HRLZ B,MODE
HRR B,CHAN
HRRZ C,FILSPC
SYSCAL OPEN,[B ? (C) ? 1(C) ? 2(C) ? 3(C)]
RETURN
CENTRY CLOSE,[CHAN] ; CLOSE CHANNEL
SYSCAL CLOSE,[CHAN]
RETURN
CENTRY CHNLOC ; FIND AVAILABLE CHANNEL
FIRSTC==1 ; CHANGE TO 0 IF SYSTEM FIXED SO THAT
; CHANNEL 0 IS NOT ARBITRARILY SMASHED
; BY .CALL MLINK, ETC.
MOVEI B,FIRSTC
CL$1: SYSCAL RFNAME,[B ? 2000,,C]
JUMPE C,CL$2 ; CHANNEL NOT OPEN
ADDI B,1
CAIGE B,20
GO CL$1
SETO A,
GO CL$RET
CL$2: MOVE A,B
CL$RET: RETURN
CENTRY UIIOT,[CHAN] ; PERFORM UNIT INPUT IOT
MOVE A,CHAN
ANDI A,17
LSH A,23.
IOR A,[.IOT A]
XCT A
RETURN
CENTRY UOIOT,[CHAN,DATA] ; PERFORM UNIT OUTPUT IOT
MOVE A,CHAN
ANDI A,17
LSH A,23.
IOR A,[.IOT DATA]
XCT A
MOVE A,DATA
RETURN
CENTRY SYSREAD,[CHAN,BUFFP,NWORDS] ; PERFORM BLOCK INPUT IOT
XENTRY SYSWRITE,SYSREAD ; PERFORM BLOCK OUTPUT IOT
MOVN A,NWORDS ; MINUS NUMBER OF WORDS
HRLZ 0,A
HRR 0,BUFFP ; SET UP CPTR
MOVE C,CHAN
ANDI C,17
LSH C,23.
IOR C,[.IOT 0]
XCT C
HLRE C,0 ; NEW COUNTER
SUB C,A ; NUMBER OF WORDS WRITTEN/READ
MOVE A,C
RETURN
CENTRY SIOT,[CHAN,BYTP,NBYTES] ; STRING IOT
SYSCAL SIOT,[CHAN ? BYTP ? NBYTES],SI$LOS
MOVE A,NBYTES
SI$RET: RETURN
SI$LOS: CROAK SIOT LOST
GO SI$RET
CENTRY SYSFINISH,[CHAN]
SYSCAL FINISH,[CHAN]
RETURN
CENTRY SYSFORCE,[CHAN]
SYSCAL FORCE,[CHAN]
RETURN
CENTRY RESET,[CHAN] ; RESET CHANNEL
MOVE A,CHAN
ANDI A,17
LSH A,23.
IOR A,[.RESET]
XCT A
SETZ A,
RETURN
CENTRY STATUS,[CHAN] ; GET CHANNEL STATUS
MOVE A,CHAN
LSH A,23.
IOR A,[.STATUS A]
XCT A
RETURN
CENTRY RFPNTR,[CHAN] ; READ FILE ACCESS POINTER
SYSCAL RFPNTR,[CHAN ? MOVEM B],RP$LOS
MOVE A,B
RP$RET: RETURN
RP$LOS: MOVN A,A
GO RP$RET
CENTRY ACCESS,[CHAN,POS] ; PERFORM RANDOM ACCESS ON CHANNEL
SYSCAL ACCESS,[CHAN ? POS]
RETURN
CENTRY FILLEN,[CHAN] ; GET FILE LENGTH
SYSCAL FILLEN,[CHAN ? 2000,,B],FL$LOS
MOVE A,B
FL$RET: RETURN
FL$LOS: MOVN A,A
GO FL$RET
CENTRY FILNAM,[CHAN,FILSPC] ; GET FILE NAME FROM CHANNEL
HRLZ B,CHAN ; CHANNEL
HRR B,FILSPC ; FILESPEC FOR RESULTS
MOVE C,4(B) ; SAVE 5TH WORD
.RCHST B, ; READ CHANNEL STATUS
HRLZS (B) ; LEFT ADJUST DEV
MOVEM C,4(B) ; RESTORE 5TH WORD
RETURN ; DONE
CENTRY RAUTH,[CHAN]
SYSCAL RAUTH,[CHAN ? MOVEM B],RA$LOS
MOVE A,B
RA$RET: RETURN
RA$LOS: MOVN A,A
GO RA$RET
CENTRY SAUTH,[CHAN,AUTHOR]
SYSCAL SAUTH,[CHAN ? AUTHOR]
RETURN
CENTRY RDMPBT,[CHAN]
SYSCAL RDMPBT,[CHAN ? MOVEM B],RD$LOS
MOVE A,B
RD$RET: RETURN
RD$LOS: MOVN A,A
GO RD$RET
CENTRY SDMPBT,[CHAN,BIT]
SYSCAL SDMPBT,[CHAN ? BIT]
RETURN
CENTRY SREAPB,[CHAN,BIT]
SYSCAL SREAPB,[CHAN ? BIT]
RETURN
CENTRY RFDATE,[CHAN] ; READ FILE CREATION DATE
SYSCAL RFDATE,[CHAN ? 2000,,B],RF$LOS
MOVE A,B
RF$RET: RETURN
RF$LOS: MOVN A,A
GO RF$RET
CENTRY SFDATE,[CHAN,FDATE] ; SET FILE CREATION DATE
SYSCAL SFDATE,[CHAN ? FDATE]
RETURN
CENTRY SRDATE,[CHAN,FDATE] ; SET FILE REFERENCE DATE
SYSCAL SRDATE,[CHAN ? FDATE]
RETURN
CENTRY DSKUPD,[CHAN]
SYSCAL DSKUPD,[CHAN]
RETURN
CENTRY RESRDT,[CHAN]
SYSCAL RESRDT,[CHAN]
RETURN
CENTRY TTYGET,[CHAN,BLOCK] ; GET TTY STATUS - WRITES 3 VALUES
HRRZ B,BLOCK
SYSCAL TTYGET,[CHAN ? MOVEM (B) ? MOVEM 1(B) ? MOVEM 2(B)]
RETURN
CENTRY TTYSET,[CHAN,BLOCK] ; SET TTY STATUS - READS 3 VALUES
HRRZ B,BLOCK
SYSCAL TTYSET,[CHAN ? (B) ? 1(B) ? 2(B)]
RETURN
CENTRY CNSGET,[CHAN,BLOCK] ; GET CONSOLE STATUS - WRITES 5 VALUES
HRRZ B,BLOCK
SYSCAL CNSGET,[CHAN ? MOVEM (B) ? MOVEM 1(B) ? MOVEM 2(B)
MOVEM 3(B) ? MOVEM 4(B)]
RETURN
CENTRY CNSSET,[CHAN,BLOCK] ; SET CONSOLE STATUS - READS 5 VALUES
HRRZ B,BLOCK
SYSCAL CNSSET,[CHAN ? (B) ? 1(B) ? 2(B) ? 3(B) ? 4(B)]
RETURN
CENTRY WHYINT,[CHAN,BLOCK]
HRRZ B,BLOCK
SYSCAL WHYINT,[CHAN ? (B) ? 1(B) ? 2(B) ? 3(B) ? 4(B)]
RETURN
CENTRY ITYIC,[CHAN] ; READ TTY INTERRUPT CHARACTER
MOVE A,CHAN ; CHANNEL
.ITYIC A,
SETO A,
RETURN
CENTRY SYSLISTEN,[CHAN] ; NCHARS = SYSLISTEN(CHAN)
SYSCAL LISTEN,[CHAN ? MOVEM B],LI$LOS
MOVE A,B
LI$RET: RETURN
LI$LOS: MOVN A,A
GO LI$RET
CENTRY RCPOS,[CHAN] ; READ TTY CURSOR POSITION (V,,H)
SYSCAL RCPOS,[CHAN ? 2000,,B],RC$LOS
MOVE A,B
RC$RET: RETURN
RC$LOS: MOVN A,A
GO RC$RET
CENTRY SCML,[CHAN,NUMBER]
SYSCAL SCML,[CHAN ? NUMBER]
RETURN
CENTRY GETCPU ; RETURN CPU TIME IN 4.069 USEC
.SUSET [24,,A]
RETURN
CENTRY CPUTM ; RETURN CPU TIME IN 1/60 SECONDS
.SUSET [24,,A]
LSH A,-12.
RETURN
CENTRY SLEEP,[TIME] ; GO TO SLEEP
MOVE A,TIME
.SLEEP A,
RETURN
CENTRY ETIME ; RETURN A TIME FOR ELAPSED TIME MEASUREMENT
.RDTIME A,
LSH A,1
RETURN
CENTRY NOW,[PCAL] ; GET CURRENT DATE AND TIME
HRRZ D,PCAL ; CAL POINTER
.RDATE C,
LDB A,[360600,,C] ; HIGH-ORDER YEAR SIXBIT
SUBI A,20
IMULI A,10.
LDB B,[300600,,C] ; LOW-ORDER YEAR SIXBIT
SUBI B,20
ADDI A,1900.(B) ; YEAR
MOVEM A,(D)
LDB A,[220600,,C] ; HIGH-ORDER MONTH
SUBI A,20
IMULI A,10.
LDB B,[140600,,C] ; LOW-ORDER MONTH
SUBI B,20
ADDI A,(B)
MOVEM A,1(D) ; MONTH
LDB A,[060600,,C] ; HIGH-ORDER DAY
SUBI A,20
IMULI A,10.
LDB B,[000600,,C] ; LOW-ORDER DAY
SUBI B,20
ADDI A,(B)
MOVEM A,2(D) ; DAY
.RTIME C,
LDB A,[360600,,C] ; HIGH-ORDER HOUR
SUBI A,20
IMULI A,10.
LDB B,[300600,,C] ; LOW-ORDER HOUR
SUBI B,20
ADDI A,(B)
MOVEM A,3(D) ; HOUR
LDB A,[220600,,C] ; HIGH-ORDER MINUTE
SUBI A,20
IMULI A,10.
LDB B,[140600,,C] ; LOW-ORDER MINUTE
SUBI B,20
ADDI A,(B)
MOVEM A,4(D) ; MINUTE
LDB A,[060600,,C] ; HIGH-ORDER SECOND
SUBI A,20
IMULI A,10.
LDB B,[000600,,C] ; LOW-ORDER SECOND
SUBI B,20
ADDI A,(B)
MOVEM A,5(D) ; SECOND
MOVEI A,(D)
RETURN
CENTRY CORBLK,[A1,A2,A3,A4,A5] ; PERFORM PAGE HACKING
SYSCAL CORBLK,[A1 ? A2 ? A3 ? A4 ? A5]
RETURN
CENTRY CORTYP,[PAGNO,OUTPUT] ; GET INFORMATION ABOUT PAGE
MOVE B,OUTPUT
SYSCAL CORTYP,[PAGNO ? 2000,,(B) ? 2000,,1(B) ? 2000,,2(B)
2000,,3(B)]
RETURN
CENTRY PAGEID,[VPN,IDN] ; GET NAMED PUBLIC PAGE
SYSCAL PAGEID,[VPN ? IDN ? 2000,,B],PI$LOS
MOVE A,B
PI$RET: RETURN
PI$LOS: MOVN A,A
GO PI$RET
CENTRY PGWRIT,[JOB,VPN]
SYSCAL PGWRIT,[JOB ? VPN]
RETURN
CENTRY RSNAME ; READ SNAME
.SUSET [.RSNAM,,A]
RETURN
CENTRY SSNAME,[NAME] ; SET SNAME
MOVE A,NAME
.SUSET [.SSNAM,,A]
RETURN
CENTRY RUNAME ; READ USER NAME
.SUSET [.RUNAM,,A]
RETURN
CENTRY RSUSET,[WHERE]
HRLZ A,WHERE
TLZ A,600000 ; CLEAR DIRECTION AND BLOCK BITS
ADDI A,A ; RESULT TO A
.SUSET A ; DO IT
RETURN
CENTRY WSUSET,[WHERE,WHAT]
HRLZ B,WHERE
TLO B,400000 ; SET DIRECTION BIT
TLZ B,200000 ; CLEAR BLOCK BIT
ADDI B,A ; TAKE WORD FROM A
MOVE A,WHAT
.SUSET B ; DO IT
RETURN
CENTRY RUSET,[WHO,WHERE]
HRLZ B,WHERE
TLZ B,600000 ; CLEAR DIRECTION AND BLOCK BITS
ADDI B,A ; RESULT TO A
HRRZ A,WHO
ANDI A,17 ; CHANNEL NUMBER
LSH A,23.
IOR A,[.USET B]
XCT A ; DO IT
RETURN
CENTRY WUSET,[WHO,WHERE,WHAT]
HRLZ B,WHERE
TLO B,400000 ; SET DIRECTION BIT
TLZ B,200000 ; CLEAR DIRECTION BIT
ADDI B,A ; TAKE WORD FROM A
HRRZ C,WHO
ANDI C,17 ; CHANNEL NUMBER
LSH C,23.
IOR C,[.USET B]
MOVE A,WHAT
XCT C ; DO IT
RETURN
CENTRY WUSRVAR,[JOB,SPEC,VALUE]
SETZ A,
SYSCAL USRVAR,[JOB ? SPEC ? VALUE]
RETURN
CENTRY DELETE,[FILNAM],[FDEV,FDIR,FFN1,FFN2] ; DELETE A FILE
MOVEI A,FDEV ; POINTER TO FILESPEC
CALL FPARSE,[FILNAM,A] ; CONSTRUCT FILESPEC
MOVEI A,FDEV
CALL SYSDELETE,[A] ; DELETE THAT FILE
RETURN
CENTRY SYSDELETE,[FILSPC] ; DELETE FILE
MOVE B,FILSPC ; ADDRESS OF FILESPEC BLOCK
HRLZI C,(SIXBIT/DSK/)
SKIPN (B)
MOVEM C,(B)
.SUSET [.RSNAM,,C]
SKIPN 3(B)
MOVEM C,3(B)
SYSCAL DELETE,[(B) ? 1(B) ? 2(B) ? 3(B)]
RETURN
CENTRY RENMWO,[CHAN,FILSPC] ; RENAME FILE OPEN FOR OUTPUT
HRRZ B,FILSPC
SYSCAL RENMWO,[CHAN ? 1(B) ? 2(B)]
RETURN
CENTRY SYSRNM,[FILSP1,FILSP2]
HRRZ B,FILSP1
HRRZ C,FILSP2
SYSCAL RENAME,[(B) ? 1(B) ? 2(B) ? 3(B) ? 1(C) ? 2(C) ? 3(C)]
RETURN
CENTRY SYSLNK,[FILSP1,FILSP2]
HRRZ B,FILSP1
HRRZ C,FILSP2
SYSCAL MLINK,[(B) ? 1(B) ? 2(B) ? 3(B) ? 1(C) ? 2(C) ? 3(C)]
RETURN
CENTRY DIRSIZ,[CHAN,BLOCK] ; WRITES 2 VALUES
HRRZ B,BLOCK
SYSCAL DIRSIZ,[CHAN ? (B) ? 1(B)]
RETURN
CENTRY TRANAD,[JOB,FROM,TO,FLAGS]
HRRZ B,JOB
HRL B,FLAGS
HRRZ C,FROM ; FROM FILESPEC
HRLI C,-4 ; MAKE IT A CPTR
HRRZ D,TO ; TO FILESPEC
HRLI D,-4 ; MAKE IT A CPTR
SYSCAL TRANAD,[B ? C ? D]
RETURN
CENTRY TRANCL,[JOB,FLAGS]
HRRZ B,JOB
HRL B,FLAGS
SKIPN FLAGS
HRLI B,300003 ; DEFAULT FLAGS
SYSCAL TRANCL,[B]
RETURN
CENTRY TRANDL,[JOB,FILSPC,FLAGS]
HRRZ B,JOB
HRL B,FLAGS
HRRZ C,FILSPC
HRLI C,-4 ; MAKE IT A CPTR
SYSCAL TRANDL,[B ? C]
RETURN
CENTRY SYSLOAD,[JOB,CHAN],[RCODE,OLDIOC] ; LOAD A PROGRAM
SETZM RCODE
CALL ON,[[[2]],[[1]]]
MOVEM A,OLDIOC
SYSCAL LOAD,[JOB ? CHAN],LD$LOS
LD$1: CALL ON,[[[2]],OLDIOC]
MOVE A,RCODE
RETURN
LD$LOS: SETOM RCODE
GO LD$1
CENTRY PDUMP,[JOBCH,DSKCH]
SETZ B,
SYSCAL PDUMP,[JOBCH ? DSKCH ? B]
RETURN
CENTRY UCLOSE,[JCHAN] ; DESTROY INFERIOR JOB
MOVE A,JCHAN
ANDI A,17
LSH A,23.
IOR A,[.UCLOSE]
XCT A
RETURN
CENTRY SYSDISOWN,[JCHAN]
SYSCAL DISOWN,[JCHAN]
RETURN
CENTRY REOWN,[JCHAN]
SYSCAL REOWN,[JCHAN]
RETURN
CENTRY SYSDTACH,[JCHAN]
SYSCAL DETACH,[JCHAN]
RETURN
CENTRY SYSATACH,[JCHAN,TTY] ; TTY<0 => DEFAULT
SKIPGE TTY
GO AT$1
SYSCAL ATTACH,[JCHAN ? TTY]
AT$RET: RETURN
AT$1: SYSCAL ATTACH,[JCHAN]
GO AT$RET
CENTRY ATTY,[JOB] ; GIVE TTY TO INFERIOR
MOVE B,JOB
ANDI B,17
LSH B,23.
IOR B,[.ATTY]
SETZ A,
XCT B
SETO A,
RETURN
CENTRY DTTY,[JOB] ; TAKE TTY FROM INFERIOR
MOVE B,JOB
ANDI B,17
LSH B,23.
IOR B,[.DTTY]
SETZ A,
XCT B
SETO A,
RETURN
CENTRY WFNZ,[PTR] ; WAIT FOR WORD TO BECOME NON-ZERO
MOVE A,PTR
SKIPN (A)
.HANG
MOVE A,(A)
RETURN
CENTRY WFZ,[PTR] ; WAIT FOR WORD TO BECOME ZERO
MOVE A,PTR
SKIPE (A)
.HANG
MOVE A,(A)
RETURN
CENTRY VAL7RET,[STR] ; VALRET AN ASCIZ STRING
HRRZ A,STR
HRLI A,(.VALUE)
XCT A
RETURN
CENTRY DEMSIG,[DEMON] ; SIGNAL A DEMON PROCESS
SYSCAL DEMSIG,[DEMON]
RETURN
CENTRY SSTATUS,[VALBLK] ; RETURNS 7 VALUES
HRRZ B,VALBLK
SYSCAL SSTATUS,[MOVEM (B) ? MOVEM 1(B) ? MOVEM 2(B)
MOVEM 3(B) ? MOVEM 4(B) ? MOVEM 5(B) ? MOVEM 6(B)]
RETURN
CENTRY MAKTAG,[TAGP]
HRRZ A,TAGP ; TAG POINTER
MOVE B,(P) ; RETURN PC
MOVEM B,(A) ; SAVE RETURN PC
MOVEI B,-2(P) ; STACK POINTER BEFORE CALL
MOVEM B,1(A) ; SAVE STACK POINTER
RETURN
CENTRY GOTAG,[TAGP]
MCALL DISMISS
MOVE A,TAGP
MOVE P,1(A)
HRRZ D,(A)
GO (D)
END

196
src/clib/c10tap.cmid Normal file
View File

@@ -0,0 +1,196 @@
;
; C10TAP - MAG TAPE INTERFACE
;
; This file is ITS dependent.
;
TITLE C10TAPE
.INSRT NC
.INSRT NM
TAPIN==17 ; TAPE CHANNEL
TPIBSZ==200 ; SIZE OF TAPE INPUT BUFFER
TPBFSZ==2000 ; SIZE OF TAPE OUTPUT BUFFER
CENTRY RWND8 ; REWIND TAPE, LEAVE OPEN FOR READ
.CLOSE TAPIN,
.OPEN TAPIN,[033726,,(SIXBIT/MT0/)]
CROAK UNABLE TO OPEN TAPE FOR READING
MOVE 0,[TAPIN,,[1]]
.MTAPE 0,
JFCL
SETZM CURBLOCK
RETURN
CENTRY OPEN8 ; OPEN TAPE FOR 8-BIT READ
MOVE A,TAPECH
CAILE A,0
GO OP$RTN
CALL RWND8
SETZM TPICNT
SETZM TPIEOF
SETOM CURBLOCK
MOVEI 0,1
MOVEM 0,TAPECH
OP$RTN: RETURN
CENTRY OPNW8 ; OPEN TAPE FOR 8-BIT WRITE
CALL RWND8
.OPEN TAPIN,[033707,,(SIXBIT/MT0/)]
CROAK UNABLE TO OPEN TAPE FOR WRITING
MOVEI A,2*TPBFSZ
MOVEM A,TPICNT
MOVE A,[442000,,TPIBUF]
MOVEM A,TPIBFP
SETOM TAPECH
RETURN
CENTRY GET16 ; READ 16-BITS
SOSGE TPICNT
CL TPREAD
ILDB A,TPIBFP
ILDB B,TPIBFP
LSH B,10
IOR A,B
MOVE B,A
ADD B,CHECKSUM
ANDI B,0177777
MOVEM B,CHECKSUM
RETURN
CENTRY PUT16,[W] ; WRITE 16 BITS
MOVE C,W
SOSGE TPICNT ; ANY ROOM ?
CL WRTAPE ; NO, FLUSH BUFFER
MOVE B,C
ADD B,CHECKSUM
ANDI B,0177777
MOVEM B,CHECKSUM
MOVE B,C
LSH B,-10
ANDI B,0377
LSH C,10
ANDI C,177400
IOR B,C
MOVE C,B
IDPB C,TPIBFP
RETURN
CENTRY SEEK8,[ACC] ; RANDOM ACCESS
SETZM CHARINBUF ; CLEAR GET8 BUFFER
MOVE A,ACC
MOVE B,A
SUB A,CURBLOCK
CAIE A,0
GO L1
; HERE IF DESIRED BLOCK IS IN BUFFER
MOVEI A,2*TPIBSZ
MOVEM A,TPICNT
MOVE A,[441000,,TPIBUF]
MOVEM A,TPIBFP
SE$RET: RETURN
L1: SUBI A,1 ; NUMBER OF BLOCKS TO SKIP
SETZM TPICNT
CAIN A,0
GO SE$RET ; WANT NEXT BLOCK, NOTHING TO SKIP
; HERE IF NECESSARY TO SKIP SOME BLOCKS
HRLZ C,A
HRLZI A,TAPIN
HRRI A,C
HRRI C,6
.MTAPE A,
JFCL
SUBI B,1
MOVEM B,CURBLOCK
RETURN
CENTRY CLOS8 ; CLOSE TAPE
SKIPGE TAPECH
CL FLUSH8 ; FLUSH BUFFER
CALL RWND8
.CLOSE TAPIN,
SETZM TAPECH
RETURN
CENTRY EOF8 ; TEST FOR END-OF-FILE
MOVE A,TPIEOF
RETURN
; *** BUFFERED I/O ROUTINES ***
; TPICNT - NUMBER OF 16-BIT INTEGERS IN BUFFER
; TPIBFP - ABPTR TO NEXT 16-BIT INTEGER IN BUFFER
; TPIBUF - THE BUFFER
; TPIEOF - -1 IF END-OF-FILE
TPR1: SOSL TPICNT
RTN
TPREAD: MOVEI A,2*TPIBSZ
MOVEM A,TPICNT
MOVE A,[441000,,TPIBUF]
MOVEM A,TPIBFP
MOVEI A,TPIBUF
HRLI A,-TPIBSZ
AOS CURBLOCK
.IOT TAPIN,A
JUMPGE A,TPR1
HLRES A
ADDI A,TPIBSZ
JUMPE A,TPR2 ; END OF FILE
LSH A,1
MOVEM A,TPICNT
GO TPR1
TPR2: SETOM TPIEOF
SETZM TPIBUF
RTN
FLUSH8: MOVEI A,2*TPBFSZ ; FLUSH (MAYBE UNFILLED) BUFFER
SUB A,TPICNT
ADDI A,1
LSH A,-1
MOVN A,A
HRLZ A,A
SKIPA
WRTAPE: HRLZI A,-TPBFSZ ; THIS IS SKIPPED FROM FLUSH8
HRRI A,TPIBUF
.IOT TAPIN,A ; WRITE BUFFER
MOVEI A,2*TPBFSZ-1
MOVEM A,TPICNT
MOVE A,[442000,,TPIBUF]
MOVEM A,TPIBFP
RTN
; *** BUFFERED I/O VARIABLES ***
.UDATA
TAPECH: BLOCK 1 ; 0 - CLOSED
; 1 - OPEN FOR READ
; -1 - OPEN FOR WRITE
TPICNT: BLOCK 1 ; TAPE I/O VARIABLES
TPIBFP: BLOCK 1
TPIEOF: BLOCK 1
TPIBUF: BLOCK TPBFSZ
MDATA CURBLOCK
BLOCK 1
MDATA CHECKSUM
BLOCK 1
MDATA CHARINBUF
BLOCK 1
END

111
src/clib/c10tmm.cmid Normal file
View File

@@ -0,0 +1,111 @@
;
; C10TMM - Program to determine the timing constants for
; the C timing package (C10TMR). The computed
; times are left in TIME1, TIME2, TIME3. Times
; are in nanoseconds.
;
; This file is ITS dependent.
; This is a stand-alone program.
;
A==1
B==2
C==3
D==4
P==17
CL==PUSHJ P,
RTN==POPJ P,
GO==JRST
.CCALL==1_27.
TP"=16 ; TIME STACK POINTER
%TPROC==0 ; THE PROCEDURE POINTER
%TNAME==1 ; THE PROCEDURE NAME (SNARFED FROM PROCEDURE)
%TNCAL==2 ; THE NUMBER OF CALLS
%TTIME==3 ; THE TOTAL AMOUNT OF ACCUMULATED TIME
%TSIZE==4 ; SIZE OF TIME TABLE ENTRY
%FTABL==0 ; POINTER TO TIME TABLE ENTRY
%FTIME==1 ; ACCUMULATED OR START TIME
%FRTNA==2 ; ACTUAL RETURN ADDRESS
%FSIZE==3 ; SIZE OF STACK FRAME
TIME1: 0
TIME2: 0
TIME3: 0
TIME4: 0
START: MOVE P,[-2000,,PDL]
MOVE A,[JSR UUOH]
MOVEM A,41
.SUSET [24,,TIME1]
CL TSUSET
.SUSET [24,,TIME2]
CL TUUO
.SUSET [24,,TIME3]
CL TEPILOG
.SUSET [24,,TIME4]
MOVE A,TIME2
SUB A,TIME1
IMULI A,4069.
IDIVI A,1000.
MOVEM A,TIME1
MOVE A,TIME3
SUB A,TIME2
IMULI A,4069.
IDIVI A,1000.
MOVEM A,TIME2
MOVE A,TIME4
SUB A,TIME3
IMULI A,4069.
IDIVI A,500.
MOVEM A,TIME3
SETZM TIME4
.VALUE
TSUSET: REPEAT 1000.,[.SUSET [24,,C]
]
RTN
TUUO: REPEAT 1000.,[
.CCALL 2,0
]
RTN
UUOH: 0
GO UUO$HANDLER
UUO$HANDLER:
MOVEM D,USAVED
LDB D,[330500,,ZERO]
GO @UUOH(D)
USAVED: 0
ZERO: 0
BAR: -1
BAR2: 0
0
0
BAR3: 0
0
0
0
TEPILOG:
MOVEI TP,BAR2
MOVEI B,BAR3
MOVEI A,0
REPEAT 500.,[
MOVE 0,C
SUBI C,37
SUB C,%FTIME(TP)
MOVE C,%FTABL(TP)
ADDM C,%TTIME(B)
SUBI TP,%FSIZE
ADDI 0,37
SUBM 0,%FTIME(TP)
GO @[.+1](A) ; TO NEXT LOCATION
]
RTN
PDL: BLOCK 2000
END START

149
src/clib/c10tmr.cmid Normal file
View File

@@ -0,0 +1,149 @@
;
; TIMER - Version of runtime to time procedure calls
;
; This file is ITS dependent.
; (Dependency is system-call to get runtime.)
;
TITLE TIMER
.INSRT NC
.INSRT NM
TIMSIZ==1000.
IF1,[
KLFLAG==0
PRINTX \KL10 (YES/NO)? \
.TTYMAC TIMEQ
IFSE TIMEQ,YES,KLFLAG==1
TERMIN
]
TP"=16 ; TIME STACK POINTER
; TIME TABLE ENTRY WORDS
%TPROC==0 ; THE PROCEDURE POINTER
%TNAME==1 ; THE PROCEDURE NAME (SNARFED FROM PROCEDURE)
%TNCAL==2 ; THE NUMBER OF CALLS
%TTIME==3 ; THE TOTAL AMOUNT OF ACCUMULATED TIME
%TSIZE==4 ; SIZE OF TIME TABLE ENTRY
; TIME STACK FRAME WORDS
%FTABL==0 ; POINTER TO TIME TABLE ENTRY
%FTIME==1 ; ACCUMULATED OR START TIME
%FRTNA==2 ; ACTUAL RETURN ADDRESS
%FSIZE==3 ; SIZE OF STACK FRAME
; TIMING CONSTANTS (IN NANOSECONDS)
; COMPUTED BY PROGRAM 'TTIMM'
IFE KLFLAG,[
SUSTIM==387909. ;TIME FOR .SUSET
UUOTIM==27929. ;TIME FOR UUO DISPATCH
EPITIM==30891. ;TIME FOR EPILOG
]
IFN KLFLAG,[
SUSTIM==71630.
UUOTIM==3373.
EPITIM==4663.
]
;
; .CCALL HANDLER (TIMING VERSION)
;
IENTRY UTCALL
.SUSET [24,,C] ; JOB ACCUMULATED TIME TO C
SKIPN TIMING" ; IS TIMING ON ?
GO UT$1 ; NO, RESUME NORMAL OPERATION
SUBI C,<UUOTIM+SUSTIM>/4069.
; FUDGE FOR SUSET AND TIME IT TOOK
; TO GET HERE
SUBM C,%FTIME(TP) ; DETERMINE CALLER'S ACCUMULATED TIME
ADDI TP,%FSIZE ; ALLOCATE NEW TIME FRAME
HRRZ B,40 ; CALLED ROUTINE
HRRZ D,-1(B) ; TIMTAB POINTER OR PROC NAME
CAIGE D,TIMTAB ; IS IT A TIMTAB POINTER?
GO UT$3 ; NO
CAMGE D,TIMEP ; IS IT A TIMTAB POINTER?
GO UT$2 ; YES
UT$3: MOVE A,D ; PROC NAME
MOVE D,TIMEP ; FIRST TIMED CALL OF ROUTINE
CAML D,ETIMEP ; IS TIME TABLE FULL?
GO UT$1 ; YES, IGNORE THIS CALL
MOVEM B,%TPROC(D) ; NO - INITIALIZE NEW TIMTAB ENTRY
MOVEM A,%TNAME(D)
SETZM %TTIME(D)
SETZM %TNCAL(D)
HRRM D,-1(B) ; PUT PTR TO TIMTAB ENTRY IN NAME WORD
MOVEI C,%TSIZE
ADDM C,TIMEP ; ADVANCE POINTER TO NEXT FREE ENTRY
UT$2: ; HERE WITH PTR TO TIMTAB ENTRY IN D
MOVEM D,%FTABL(TP) ; STORE POINTER IN TIME STACK
AOS %TNCAL(D) ; INCREMENT USE COUNT
UT$1: ; CONTINUE WITH CALL PROCESSING
HRRZ C,40 ; THE CALLED PROCEDURE
JUMPE C,UCBAD" ; NO SUCH PROCEDURE
HLRZ 0,-1(C) ; THE NUMBER OF FORMAL ARGS
CAIL 0,20 ; REASONABLE NUMBER?
GO UCBAD ; NO, NOT A PROCEDURE
LDB B,[270400,,40] ; THE NUMBER OF ACTUAL ARGS
SUB 0,B ; NUMBER OF ARGS NOT GIVEN
JUMPL 0,CODE [ ; TOO MANY ARGS GIVEN
ADD P,0 ; POP OFF EXTRA ARGS
GO UTDOIT ; MAKE THE CALL
]
UTLOOP: SOJL 0,UTDOIT ; FOR EACH ARG NEEDED
PUSH P,[0] ; PUSH ZERO ARG
GO UTLOOP ; LOOP
UTDOIT: SKIPN TIMING
GO UT$4
MOVE B,UUOH ; RETURN ADDRESS
MOVEM B,%FRTNA(TP) ; SAVE IT
MOVEI B,%FTIME(TP) ; CONSTRUCT .SUSET
HRLI B,24 ; GET START TIME FOR CALLED PROC
.SUSET B ; AND STORE IN TIME STACK FRAME
PUSHJ P,(C) ; CALL PROCEDURE
.SUSET [24,,C] ; JOB ACCUMULATED TIME
MOVE 0,C
SUBI C,SUSTIM/4069. ; FUDGE FOR .SUSET TIME
SUB C,%FTIME(TP) ; SUBTRACT START TIME
MOVE B,%FTABL(TP) ; TIMTAB ENTRY POINTER
ADDM C,%TTIME(B) ; ADD TO ACCUMULATED TIME FOR CALLEE
SUBI TP,%FSIZE ; POP TIME STACK FRAME
ADDI 0,<EPITIM>/4069. ; FUDGE
SUBM 0,%FTIME(TP) ; ADJUST START TIME OF CALLER
GO @%FRTNA+%FSIZE(TP) ; RETURN TO CALLER
UT$4: PUSH P,UUOH"
GO (C)
IENTRY TINIT
SETOM TIMING"
MOVEI A,UTCALL
MOVEM A,UUOTAB"+1
MOVEI TP,TIMSTK
MOVEM TP,TPINIT"
MOVEI A,TPRT"
MOVEM A,EXITER"
GO LINIT"
.IDATA
MDATA TIMEP
TIMTAB
MDATA ETIMEP
TIMTAB+<TIMSIZ*%TSIZE>
.UDATA
MDATA TIMTAB
BLOCK TIMSIZ*%TSIZE
MDATA TIMSTK
BLOCK TIMSIZ
END

151
src/clib/c10tpr.c Normal file
View File

@@ -0,0 +1,151 @@
# include "clib/c.defs"
# include "clib/its.bits"
/**********************************************************************
C10TPR - Printing Routine for C Timer Package
*ITS*
**********************************************************************/
# rename null "$NULL$"
# rename timing "TIMING"
# rename timtab "TIMTAB"
# rename timep "TIMEP"
# rename tprt "TPRT"
struct _tentry {int *proc, pname, count, time;};
# define tentry struct _tentry
extern int timing;
extern tentry timtab[], *timep;
extern int cout;
/* All times are kept in machine-dependent Units
and converted upon output to the appropriate
units.
*/
tprt ()
{int fout, /* output file */
total_time, /* total CPU time used */
smallest, /* smallest average time */
time, /* time used by current routine */
average, /* average time of current routine */
percent, /* percentage CPU time, current routine */
cpercent, /* cumulative percentage CPU time */
ctime, /* cumulative CPU time */
count, /* number of calls, current routine */
ncalls, /* total number of calls */
namep, /* pointer to current routine name */
nulltime, /* time to call null routine */
t,
c;
tentry *ip, *ip1;
t = rsuset (URUNT);
c = 50;
timing = -1;
while (--c >= 0)
{null ();
null ();
null ();
null ();
null ();
null ();
null ();
null ();
null ();
null ();
null ();
null ();
null ();
null ();
null ();
null ();
null ();
null ();
null ();
null ();
}
timing = 0;
fout = copen ("timer.output", 'a');
if (fout<0) fout = copen ("timout", 'w');
if (fout<0) fout = cout;
cprint (fout, "\n\n\n *** TIMING INFORMATION ***\n\n");
cprint (fout, "TIME(usec) PERCENT CUM. %% NO. CALLS AVG. TIME ROUTINE NAME\n\n");
/* null entry should be last */
--timep;
nulltime = timep->time / timep->count;
/* sort entries in order of decreasing CPU time used */
for (ip=timtab;ip<timep;++ip)
for (ip1 = ip+1;ip1<timep;++ip1)
if (ip1->time > ip->time)
bswap (ip, ip1, 4);
total_time = 0;
for (ip=timtab;ip<timep;++ip)
total_time =+ ip->time;
ncalls = 0;
smallest = 10000; /* big number */
ctime = 0;
for (ip=timtab;ip<timep;++ip)
{time = ip->time;
ctime =+ time;
percent = (time * 1000) / total_time;
cpercent = (ctime * 1000) / total_time;
count = ip->count;
ncalls =+ count;
namep = (ip->pname) | 0440700000000;
average = time/count;
if (average<smallest && average>0) smallest=average;
cprint (fout, "%10d%8d.%1d%8d.%1d",
u2mic (time), percent/10, percent%10,
cpercent/10, cpercent%10);
cprint (fout, "%11d%12d ", count, u2mic (average));
while (c = ildb (&namep)) cputc (c, fout);
cputc ('\n', fout);
}
if (smallest<nulltime) nulltime=smallest;
time = ncalls * nulltime;
percent = (time * 1000) / total_time; /* percent * 10 */
cprint (fout, "\nTOTAL TIME = %d MSEC.\n", u2mil (total_time));
cprint (fout, "PROC. CALL TIME = %d USEC.\n", u2mic (nulltime));
cprint (fout, "NO. CALLS = %d\n", ncalls);
cprint (fout, "EST. CALL OVERHEAD = %d.%d %%\n",
percent/10, percent%10);
cclose (fout);
}
u2mil (t) /* convert Units to Milliseconds */
{return ((t * 407) / 100000);}
u2mic (t) /* convert Units to Microseconds */
{return ((t * 407) / 100);}
bswap (p, q, n) int *p, *q;
{int t;
while (--n >= 0)
{t = *p;
*p++ = *q;
*q++ = t;
}
}
null () {;}

375
src/clib/c10tty.c Normal file
View File

@@ -0,0 +1,375 @@
/*
* C TTY Package
*
* routines:
*
* tyiopn - open TTY input channel
* tyi - read char from TTY (buffered)
* utyi - read char from TTY (unbuffered)
* get_buf - read string from TTY
* setprompt - set default TYI prompt string
* tyoopn - open TTY output channel
* tyo - output char to TTY (buffered)
* utyo - output char to TTY (unbuffered)
* spctty - output display code (unbuffered)
* tyos - output string to TTY (buffered)
* tyo_flush - flush TTY output buffer
*
* global variables:
*
* ttynp - ^L handler
*
* internal routines:
*
* ttyih - TTY interrupt handler
* ctrlch - return display width of char
*
*/
# include "c.defs"
# define tty_input_buffer_size 120
# define tty_output_buffer_size 60
# rename tty_input_channel "TYICHN"
# rename tty_output_channel "TYOCHN"
# rename tty_device_code "TTYDEV"
# rename tty_input_buffer "TYIBUF"
# rename tty_input_ptr "TYIPTR"
# rename tty_input_count "TYICNT"
# rename tty_output_buffer "TYOBUF"
# rename tty_output_ptr "TYOPTR"
# rename tty_output_count "TYOCNT"
# rename tty_output_bptr "TYOBPT"
# rename tty_default_prompt "TTYDPR"
int tty_input_channel -1;
int tty_output_channel -1;
int tty_device_code -1;
char tty_input_buffer[tty_input_buffer_size];
char *tty_input_ptr;
int tty_input_count;
char tty_output_buffer[tty_output_buffer_size];
char *tty_output_ptr {tty_output_buffer};
int tty_output_count;
int tty_output_bptr;
char *tty_default_prompt;
int ttxnp(); /* default TTY ^L handler */
int (*ttynp)() {ttxnp}; /* called on ^L */
/**********************************************************************
TYI - Read Character From TTY (buffered)
**********************************************************************/
tyi ()
{while (tty_input_count <= 0)
{if (tty_input_channel < 0) tyiopn ();
tty_input_count = get_buf (tty_input_buffer,
tty_input_buffer_size, '\r', "");
tty_input_ptr = tty_input_buffer;
if (tty_input_count == 0) return (0);
}
--tty_input_count;
return (*tty_input_ptr++);
}
/**********************************************************************
UTYO - output character to TTY (unbuffered)
**********************************************************************/
utyo (c)
{if (tty_output_channel >= 0 || tyoopn() >= 0)
{if (tty_output_count > 0) tyo_flush ();
c =& 0177;
if (c != 16) uoiot (tty_output_channel, c);
else
{uoiot (tty_output_channel, '^');
uoiot (tty_output_channel, 'P');
}
}
}
/**********************************************************************
TYO - output character to TTY
**********************************************************************/
tyo (c)
{c =& 0177;
if (tty_output_channel >= 0 || tyoopn() >= 0)
{if (c != 16) {*tty_output_ptr++ = c; ++tty_output_count;}
else
{*tty_output_ptr++ = '^';
*tty_output_ptr++ = 'P';
tty_output_count =+ 2;
}
if (c=='\r' || tty_output_count >= tty_output_buffer_size-2)
tyo_flush ();
}
}
/**********************************************************************
TYO_FLUSH - flush TTY output buffer
**********************************************************************/
tyo_flush ()
{if (tty_output_channel >= 0 && tty_output_count > 0)
{siot (tty_output_channel, tty_output_bptr,
tty_output_count);
tty_output_ptr = tty_output_buffer;
tty_output_count = 0;
}
}
/**********************************************************************
TYOS - Output String to TTY
**********************************************************************/
tyos (s) char s[];
{int c;
while (c = *s++) tyo (c=='\n' ? '\r' : c);
}
/**********************************************************************
SPCTTY - Send "special" display control character to TTY.
**********************************************************************/
spctty (c)
{if (tty_output_channel >= 0 || tyoopn() >= 0)
{if (tty_output_count > 0) tyo_flush ();
uoiot (tty_output_channel, 16);
uoiot (tty_output_channel, c);
}
}
/**********************************************************************
UTYI - read character from TTY (unbuffered and unechoed)
**********************************************************************/
int utyi ()
{if (tty_input_channel<0) tyiopn ();
if (tty_output_count > 0) tyo_flush ();
return (uiiot (tty_input_channel));
}
/**********************************************************************
GET_BUF - Read characters from TTY until end-of-file
simulated or given break character seen.
Read characters into given buffer, including
the terminating break character (if any).
Return a count of the number of characters
placed in the buffer. The given prompt string
will be printed first; it will be reprinted
when ^L is typed.
**********************************************************************/
int get_buf (buf, buf_size, break_ch, prompt) char buf[], prompt[];
{char *p, *q, pbuf[tty_output_buffer_size];
int i, c, j;
if (tty_input_channel<0) tyiopn ();
if (!prompt[0]) /* no explicit prompt */
{if (tty_output_count > 0) /* use partial output line */
{tty_output_buffer[tty_output_count] = 0;
stcpy (tty_output_buffer, pbuf);
prompt = pbuf;
}
else if (tty_default_prompt) /* use default */
prompt = tty_default_prompt;
}
if (prompt != pbuf) tyos (prompt);
if (tty_output_count > 0) tyo_flush ();
p = buf;
i = 0; /* number of chars in buffer */
while (TRUE)
{c = uiiot (tty_input_channel);
if (c != break_ch) switch (c) {
case 0177: /* rubout - delete prev char */
if (i>0)
{c = *--p;
--i;
if (tty_device_code==2) /* display */
{if (c=='\r')
{spctty ('U');
q = p;
while ((c = *--q) != '\r' &&
q>=buf)
{j = ctrlch(c);
while (--j>=0) spctty ('F');
}
if (q<buf)
{q = prompt;
while (*q) ++q;
while ((c = *--q) != '\n' &&
q>=prompt)
{j = ctrlch(c);
while (--j>=0) spctty ('F');
}
}
}
else
{j = ctrlch(c);
while (--j>=0) spctty ('X');
}
}
else utyo (c);
}
continue;
case '\p': /* redisplay buffer */
*p = 0;
(*ttynp) (tty_device_code==2, prompt, buf);
continue;
case 0: /* simulate end-of-file */
q = buf;
while (q < p) {if (*q == '\r') *q = '\n'; ++q;}
return (i);
case '\n': /* ignore - dont want to echo it */
continue;
default: if (i <= buf_size - 2)
{++i;
utyo (*p++ = c);
}
else utyo (07); /* beep */
continue;
}
break;
}
utyo ('\r');
*p++ = c;
q = buf;
while (q < p) {if (*q == '\r') *q = '\n'; ++q;}
return (i+1);
}
/**********************************************************************
TTXNP - Default TTY ^L handler
**********************************************************************/
ttxnp (display, prompt, buf)
int display;
char *prompt, *buf;
{if (display) spctty ('C'); else tyo ('\r');
tyos (prompt);
tyos (buf);
tyo_flush ();
}
/**********************************************************************
TTYIH - TTY Input Interrupt Handler
**********************************************************************/
ttyih ()
{int c;
c = ityic (tty_input_channel);
if (c == 023) signal (ctrls_interrupt);
else if (c == 007) signal (ctrlg_interrupt);
}
/**********************************************************************
TYIOPN - Open TTY for INPUT.
**********************************************************************/
channel tyiopn()
{int block[3];
if (tty_input_channel < 0)
tty_input_channel = fopen ("/tty", 0);
on (ttyi_interrupt, ttyih);
ttyget (tty_input_channel, block);
block[0] = 020202020202;
block[1] = 030202020202;
ttyset (tty_input_channel, block);
tty_device_code = status (tty_input_channel) & 077;
return (tty_input_channel);
}
/**********************************************************************
TYOOPN - Open TTY for OUTPUT.
**********************************************************************/
channel tyoopn()
{int i;
if (tty_output_channel < 0)
{tty_output_channel = fopen ("/tty", 021);
i = tty_output_buffer;
i =| 0444400000000;
tty_output_bptr = i;
}
return (tty_output_channel);
}
/**********************************************************************
CTRLCH - Return the number of characters a character
prints as.
**********************************************************************/
int ctrlch (c)
{if (c==0177) return (2);
if (c>=' ' || c==033 || c=='\t') return (1);
if (c=='\b' || c==07) return (0);
return (2);
}
/**********************************************************************
SETPROMPT - Set Default Input Prompt String
**********************************************************************/
setprompt (s)
char *s;
{tty_default_prompt = s;}

216
src/clib/cfloat.cmid Normal file
View File

@@ -0,0 +1,216 @@
;
; CFLOAT - FLOATING POINT STUFF
;
; This file is PDP-10 dependent, system-independent.
;
TITLE CFLOAT
.INSRT NC
.INSRT NM
; CONTAINS: LOG, EXP, COS, SIN, ATAN, SQRT, DTRUNCATE, DROUND, DABS
CENTRY LOG,[V]
MOVE B,V
JUMPLE B,OUTRNG
LDB D,[331100,,B] ;GRAB EXPONENT
SUBI D,201 ;REMOVE BIAS
TLZ B,777000 ;SET EXPONENT
TLO B,201000 ; TO 1
MOVE A,B
FSBR A,SQRT2
FADR B,SQRT2
FDVB A,B
FMPR B,B
MOVE C,[0.434259751]
FMPR C,B
FADR C,[0.576584342]
FMPR C,B
FADR C,[0.961800762]
FMPR C,B
FADR C,[2.88539007]
FMPR C,A
FADR C,[0.5]
MOVE B,D
FSC B,233
FADR B,C
FMPR B,[0.693147180] ;LOG E OF 2
MOVE A,B
RETURN
CENTRY EXP,[V]
MOVE B,V
PUSH P,B
MOVM A,B
SETZM B
FMPR A,[0.434294481] ;LOG BASE 10 OF E
MOVE D,[1.0]
CAMG A,D
GO RATEX
MULI A,400
ASHC B,-243(A)
CAILE B,43
GO OUTRNG
CAILE B,7
GO EXPR2
EXPR1: FMPR D,FLOAP1(B)
LDB A,[103300,,C]
SKIPE A
TLO A,177000
FADR A,A
RATEX: MOVEI B,7
SETZM C
RATEY: FADR C,COEF2-1(B)
FMPR C,A
SOJN B,RATEY
FADR C,[1.0]
FMPR C,C
FMPR D,C
MOVE B,[1.0]
SKIPL (P) ;SKIP IF INPUT NEGATIVE
SKIPN B,D
FDVR B,D
MOVE A,B
SUB P,[1,,1]
RETURN
EXPR2: LDB D,[030300,,B]
ANDI B,7
MOVE D,FLOAP1(D)
FMPR D,D ;TO THE 8TH POWER
FMPR D,D
FMPR D,D
GO EXPR1
COEF2: 1.15129278
0.662730884
0.254393575
0.0729517367
0.0174211199
2.55491796^-3
9.3264267^-4
FLOAP1: 1.0
10.0
100.0
1000.0
10000.0
100000.0
1000000.0
10000000.0
OUTRNG: CROAK [ARGUMENT OUT OF RANGE]
GO RTN1
CENTRY COS,[V]
MOVE B,V
FADR B,[1.570796326] ;COS(X)=SIN (X+PI/2)
CALL SIN,[B]
RTN1: RETURN
CENTRY SIN,[V]
MOVE B,V
CL .SIN
RETURN
.SIN: MOVM A,B
CAMG A,[.0001]
RTN ;GOSPER'S RECURSIVE SIN.
FDVR B,[-3.0] ;SIN(X)=4*SIN(X/-3)**3-3*SIN(X/-3)
CL .SIN
FSC A,1
FMPR A,A
FADR A,[-3.0]
FMPRB A,B
RTN
CENTRY SQRT,[V]
MOVE B,V
MOVE A,B
ASH B,-1
FSC B,100
SQ2: MOVE C,B ;NEWTON'S METHOD, SPECINER'S HACK.
FDVRM A,B
FADRM C,B
FSC B,-1
CAME C,B
GO SQ2
MOVE A,B
RETURN
CENTRY ATAN,[V],[TEMP]
MOVE B,V
MOVEM B,TEMP
MOVM D,B
CAMG D,[0.4^-8] ;SMALL ENOUGH SO ATAN(X)=X?
GO ATAN3 ;YES
CAML D,[7.0^7] ;LARGE ENOUGH SO THAT ATAN(X)=PI/2?
GO ATAN1 ;YES
MOVN C,[1.0]
CAMLE D,[1.0] ;IS ABS(X)<1.0?
FDVM C,D ;NO,SCALE IT DOWN
MOVE B,D
FMPR B,B
MOVE C,[1.44863154]
FADR C,B
MOVE A,[-0.264768620]
FDVM A,C
FADR C,B
FADR C,[3.31633543]
MOVE A,[-7.10676005]
FDVM A,C
FADR C,B
FADR C,[6.76213924]
MOVE B,[3.70925626]
FDVR B,C
FADR B,[0.174655439]
FMPR B,D
JUMPG D,ATAN2 ;WAS ARG SCALED?
FADR B,PI2 ;YES, ATAN(X)=PI/2-ATAN(1/X)
GO ATAN2
ATAN1: MOVE B,PI2
ATAN2: SKIPGE TEMP ;WAS INPUT NEGATIVE?
MOVNS B ;YES,COMPLEMENT
ATAN3: MOVE A,B
RETURN
SQRT2: 1.41421356
PI2: 3.1415926535/2
CENTRY DROUND,[V]
MOVE A,V
FADR A,[.499999]
JUMPL A,ROUND1
UFA A,[233000000000]
TLZ B,777000
GO ROUND2
ROUND1: UFA A,[233000000000]
TLO B,777000
ROUND2: MOVE A,B
RETURN
CENTRY DTRUNCATE,[V]
MOVE A,V
UFA A,[233000000000]
TLZ B,777000
MOVE A,B
RETURN
CENTRY DABS,[V]
MOVE A,V
JUMPGE A,RET
MOVN A,A
JUMPGE A,RET
TLZ A,400000
RET: RETURN
END

15
src/clib/clib.h Normal file
View File

@@ -0,0 +1,15 @@
/* Handy definitions */
#define OPENLOSS (-1) /* Returned by COPEN if open fails */
typedef int SIXBIT; /* Six characters packed in one word */
typedef struct { /* ITS filespec in sixbit */
SIXBIT dev, /* Device */
fn1, /* First filename */
fn2, /* Second filename */
dir; /* Directory */
} FILESPEC;
#define TRUE 1
#define FALSE 0

47
src/clib/clib.prglst Normal file
View File

@@ -0,0 +1,47 @@
; CLIB PRGLST
; *ITS*
; This file is a Stinkr XFILE that lists the program files that make up the
; shared C library. It is used in the construction of a new library. It
; is also used to construct test versions of programs not using the shared
; library and to construct timing versions of programs (which cannot use
; the shared library).
; The following are ITS- dependent files from C10LIB:
l clib;c10cor
l clib;c10exp
l clib;c10fd
l clib;c10fil
l clib;c10fnm
l clib;c10fo
l clib;c10int
l clib;c10io
l clib;c10map
l clib;c10mio
l clib;c10pag
l clib;c10sys
l clib;c10tty
; The following are ITS-independent files from CLIB:
l clib;ac
l clib;alloc
l clib;apfnam
l clib;atoi
l clib;blt
l clib;cfloat
l clib;cprint
l clib;date
l clib;fprint
l clib;match
l clib;pr60th
l clib;random
l clib;stkdmp
l clib;string
l clib;uuoh
; This must be last:
l clib;c10run


15
src/clib/clib.tester Normal file
View File

@@ -0,0 +1,15 @@
; CLIB TESTER
; *ITS*
; This file is a Stinkr XFILE to be used to construct test versions of
; programs that do not use the shared C library. Construction of such
; programs is useful to test changes to library routines prior to the
; construction of a new version of the library.
; This file must be XFILEd first.
; Segment 0 must start at 100.
s 100,n,p,n
i linit
x c;clib prglst

17
src/clib/clib.timer Normal file
View File

@@ -0,0 +1,17 @@
; CLIB TIMER
; *ITS*
; This file is a Stinkr XFILE to be used to construct timing versions of
; programs. The only difference from normal programs is that a different
; handler is used for the procedure call UUOs.
; This file must be XFILEd first.
; Segment 0 must start at 100.
s 100,100000,400000,600000
i tinit
l clib;c10tmr
l clib;c10tpr
x clib;clib prglst

176
src/clib/cprint.c Normal file
View File

@@ -0,0 +1,176 @@
/*
CPRINT - C Formatted Print Routine
Extendable Format Version:
Print Routines should expect the following
arguments (n specified when defined):
1 to n: n data arguments
n+1: file descriptor
n+2: field width (0 if none given)
*/
# define WORDMASK 077777777777
# define SMALLEST "-34359738368"
extern int cin, cout, cerr;
int prc(), prd(), pro(), prs();
static int (*format_table[26]) () {
/* a */ 0, 0, prc, prd, 0, 0, 0, 0,
/* i */ 0, 0, 0, 0, 0, 0, pro, 0,
/* q */ 0, 0, prs, 0, 0, 0, 0, 0,
/* y */ 0, 0};
static int format_nargs [26] {
/* a */ 0, 0, 1, 1, 0, 0, 0, 0,
/* i */ 0, 0, 0, 0, 0, 0, 1, 0,
/* q */ 0, 0, 1, 0, 0, 0, 0, 0,
/* y */ 0, 0};
deffmt (c, p, n) int (*p)();
{if (c >= 'A' && c <= 'Z') c =+ ('a' - 'A');
if (c >= 'a' && c <= 'z')
{if (n >= 0 && n <= 3)
{format_table [c - 'a'] = p;
format_nargs [c - 'a'] = n;
}
else cprint (cerr, "bad nargs to DEFFMT: %d\n", n);
}
else cprint (cerr, "bad character to DEFFMT: %c\n", c);
}
cprint (a1,a2,a3,a4,a5,a6,a7,a8)
{int *adx, c, width;
char *fmt;
int fn, (*p)(), n;
if (cisfd(a1)) /* file descriptor */
{fn = a1;
fmt = a2;
adx = &a3;
}
else
{fn = cout;
fmt = a1;
adx = &a2;
}
while (c= *fmt++)
{if (c!='%') cputc (c,fn);
else
{width = 0;
while ((c = *fmt)>='0' && c<='9')
width = (width*10) + (*fmt++ - '0');
c = *fmt++;
if (c >= 'A' && c <= 'Z') c =+ ('a' - 'A');
if (c >= 'a' && c <= 'z')
{p = format_table [c - 'a'];
n = format_nargs [c - 'a'];
if (p)
{switch (n) {
case 0: (*p) (fn, width); break;
case 1: (*p) (adx[0], fn, width); break;
case 2: (*p) (adx[0], adx[1], fn, width); break;
case 3: (*p) (adx[0], adx[1], adx[2], fn, width); break;
}
adx =+ n;
continue;
}
cputc (c, fn);
}
else cputc (c, fn);
}
}
}
/**********************************************************************
PRO - Print Octal Integer
**********************************************************************/
pro (i, f, w)
{int b[30], *p, a;
if (!cisfd(f)) f = cout;
if (w<0 || w>200) w = 0;
p = b;
while (a = ((i>>3) & WORDMASK))
{*p++ = (i&07) + '0';
i = a;
}
*p++ = i+'0';
if (i) *p++ = '0';
i = w - (p-b);
while (--i>=0) cputc (' ', f);
while (p > b) cputc (*--p, f);
}
/**********************************************************************
PRD - Print Decimal Integer
**********************************************************************/
prd (i, f, w)
{int b[30], *p, a, flag;
flag = 0;
if (!cisfd(f)) f = cout;
if (w<0 || w>200) w = 0;
p = b;
if (i < 0) {i = -i; flag = 1;}
if (i < 0) {stcpy (SMALLEST, b); p = b+slen(b); flag = 0;}
else
{while (a = i/10)
{*p++ = i%10 + '0';
i = a;
}
*p++ = i+'0';
}
if (flag) *p++ = '-';
i = w - (p-b);
while (--i>=0) cputc (' ', f);
while (p > b) cputc (*--p, f);
}
/**********************************************************************
PRS - Print String
**********************************************************************/
prs (s, f, w) char *s;
{int i;
if (!cisfd(f)) f = cout;
if (w<0 || w>200) w = 0;
i = (w > 0 ? w - slen (s) : 0);
while (--i >= 0) cputc (' ', f);
while (i = *s++) cputc (i, f);
}
/**********************************************************************
PRC - Print Character
**********************************************************************/
prc (c, f, w)
{int i;
if (!cisfd(f)) f = cout;
if (w<0 || w>200) w = 0;
i = w - 1;
while (--i >= 0) cputc (' ', f);
cputc (c, f);
}

39
src/clib/crate.10 Normal file
View File

@@ -0,0 +1,39 @@
TITLE CRATE C LIBRARY DESECRATOR FOR VERSION 10
A==1
GO==JRST
.GLOBAL INIT,PAGENO,NPAGES,VERNAM
INIT: .VALUE [ASCIZ/: INITIALIZE IF NOT FOR VERSION 10 
 /]
.CALL [SETZ
SIXBIT/OPEN/
1000,,1 ; CHANNEL 1
[SIXBIT/DSK/]
[SIXBIT/[CLIB]/]
VERNAM
SETZ [SIXBIT/C/]
]
.VALUE [ASCIZ/: UNABLE TO GET LIBRARY FILE 
/]
MOVN A,NPAGES
HRLZ A,A
HRR A,PAGENO
.CALL [SETZ
'CORBLK
1000,,600000 ; READ-WRITE ACCESS
1000,,-1 ; PUT IN MY MAP
A ; AOBJN POINTER
401000,,1 ; FROM FILE
]
.VALUE [ASCIZ/: UNABLE TO MAP IN LIBRARY FILE 
/]
.CLOSE 1,
.VALUE [ASCIZ/: ALL SET 
:SL /]
GO .-1
PAGENO: 246. ; FIRST PAGE TO SMASH
NPAGES: 10. ; NUMBER OF PAGES TO SMASH
VERNAM: SIXBIT/10/ ; VERSION NUMBER IN SIXBIT
END INIT

16
src/clib/ctype.c Normal file
View File

@@ -0,0 +1,16 @@
# include "ctype.h"
# define S _S
# define N _N
# define L _L
# define U _U
char _ctype[] {
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
S, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
N, N, N, N, N, N, N, N, N, N, 0, 0, 0, 0, 0, 0,
0, U, U, U, U, U, U, U, U, U, U, U, U, U, U, U,
U, U, U, U, U, U, U, U, U, U, U, 0, 0, 0, 0, 0,
0, L, L, L, L, L, L, L, L, L, L, L, L, L, L, L,
L, L, L, L, L, L, L, L, L, L, L, 0, 0, 0, 0, 0};

154
src/clib/date.c Normal file
View File

@@ -0,0 +1,154 @@
/*
DATE - Date Hacking Routines
These routines recognize three representations for dates:
(1) CAL - calender date, a system-independent representation
consisting of a record containing six integers
for the year, month, day, hour, minute, and second
(2) FDATE - the ITS date representation used in file directories
(3) UDATE - the UNIX date representation, seconds since
Jan 1, 1970, GMT.
(4) TDATE - the TOPS-20 date representation
The routines:
u2cal (udate, cd) - convert udate to cal
udate = cal2u (cd) - convert cal to udate
f2cal (fdate, cd) - convert fdate to cal
fdate = cal2f (cd) - convert cal to fdate
t2cal (tdate, cd)
tdate = cal2t (cd)
prcal (cd, fd) - print cal (CIO)
*/
# define ZONE 5 /* offset of local zone from GMT */
struct _cal {int year, month, day, hour, minute, second;};
# define cal struct _cal
static int month_tab1[] {0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334};
static int month_tab2[] {0, 31, 60, 91, 121, 152, 182, 213, 244, 274, 305, 335};
static int year_tab[] {0, 365, 2*365, 3*365+1};
# define four_years (4*365+1)
static char *month_name[] {
"Jan", "Feb", "Mar", "Apr", "May", "Jun",
"Jul", "Aug", "Sep", "Oct", "Nov", "Dec"};
# rename srctab "SRCTAB"
u2cal (udate, cd) cal *cd;
{udate =- (ZONE*60*60);
cd->second = udate%60; udate =/ 60;
cd->minute = udate%60; udate =/ 60;
cd->hour = udate%24; udate =/ 24;
cd->year = 1970 + 4*(udate/four_years);
udate =% four_years;
cd->year =+ srctab (year_tab, 4, &udate);
cd->month = srctab (cd->year%4==0 ? month_tab2 : month_tab1,
12, &udate) + 1;
cd->day = udate + 1;
}
int cal2u (cd) cal *cd;
{int udate, year;
year = cd->year;
udate = cd->second + 60*(cd->minute + 60*(cd->hour + 24*(cd->day-1)));
udate =+ (year%4==0 ? month_tab2 : month_tab1) [cd->month-1] * 60*60*24;
year =- 1970;
if (year<0) year=0;
udate =+ 60*60*24*(four_years*(year/4) + year_tab[year%4]);
udate =+ (ZONE*60*60);
return (udate);
}
f2cal (fdate, cd) cal *cd;
{cd->year = 1900 + ((fdate>>27) & 0177);
if ((cd->month = (fdate>>23) & 017) > 12) cd->month = 0;
cd->day = (fdate>>18) & 037;
fdate = (fdate & 0777777) >> 1;
cd->second = fdate % 60;
fdate =/ 60;
cd->minute = fdate % 60;
cd->hour = fdate / 60;
}
int cal2f (cd) cal *cd;
{int fdate;
fdate = 2*(cd->second + 60*(cd->minute + 60*cd->hour));
fdate =| cd->day << 18;
fdate =| cd->month << 23;
fdate =| (cd->year - 1900) << 27;
return (fdate);
}
t2cal (tdate, cd) cal *cd;
{int vec[3], udate;
SYSODCNV (tdate, 0, vec);
cd->year = vec[0] >> 18;
cd->month = (vec[0] & 0777777) + 1;
cd->day = (vec[1] >> 18) + 1;
udate = vec[2] & 0777777;
cd->second = udate%60; udate =/ 60;
cd->minute = udate%60; udate =/ 60;
cd->hour = udate%24;
}
int cal2t (cd) cal *cd;
{char buf[100];
int f;
f = copen (buf, 'w', "s");
cprint (f, "%d/%d/%d %d:%d:%d", cd->month, cd->day, cd->year,
cd->hour, cd->minute, cd->second);
cclose (f);
return (SYSIDTIM (mkbptr (buf), 0));
}
prcal (cd, f) cal *cd;
{char *s;
int m;
m = cd->month-1;
if (m>=0 && m<=11) s = month_name[m];
else s = "?";
cprint (f, "%s%3d%5d ", s, cd->day, cd->year);
cputc (cd->hour/10+'0', f);
cputc (cd->hour%10+'0', f);
cputc (':', f);
cputc (cd->minute/10+'0', f);
cputc (cd->minute%10+'0', f);
cputc (':', f);
cputc (cd->second/10+'0', f);
cputc (cd->second%10+'0', f);
}
int srctab (tab, sz, n) int *tab, sz, *n;
{int *p, i;
p = tab+sz;
i = *n;
while (--p>=tab)
{if (*p <= i)
{*n = i - *p;
return (p-tab);
}
}
return (0);
}

89
src/clib/fprint.c Normal file
View File

@@ -0,0 +1,89 @@
#
/*
*
* FPRINT - Floating-Point Print Routine
*
* requires:
*
* i = dtruncate (d)
* i = dround (d)
* d = dabs (d)
* cputc (c, fd)
*
* internal routines and tables:
*
* fp3, fp4, fp5, fp6, ft0, ft1, ft10
*
*/
static double ft0[] {1e1, 1e2, 1e4, 1e8, 1e16, 1e32};
static double ft1[] {1e-1, 1e-2, 1e-4, 1e-8, 1e-16, 1e-32};
static double ft10[] {1e0, 1e1, 1e2, 1e3, 1e4, 1e5, 1e6, 1e7};
double dabs ();
fprint (d, fd)
double d;
{if (d<0) {cputc ('-', fd); d = dabs (d);}
if (d>0)
{if (d < 1.0) {fp4 (d, 0, fd); return;}
else if (d >= 1e8) {fp4 (d, 1, fd); return;}
}
fp3 (d, fd);
}
fp3 (d, fd) /* print positive double */
double d;
{int i, n;
double fraction;
i = dtruncate (d);
fraction = d - i;
n = fp5 (i, fd); /* return # of digits printed */
cputc ('.', fd);
n = 8 - n;
fraction =* ft10[n];
i = dround (fraction);
fp6 (i, n, fd); /* prints n digits */
}
fp4 (d, flag, fd)
double d;
{int c, e;
c = 6;
e = 0;
while (--c >= 0)
{e =<< 1;
if (flag ? d >= ft0[c] : d <= ft1[c])
{++e;
d =* (flag ? ft1[c] : ft0[c]);
}
}
if (d < 1.0) {++e; d =* 10.0;}
fp3 (d, fd);
cputc ('e', fd);
cputc (flag ? '+' : '-', fd);
fp5 (e, fd);
}
int fp5 (i, fd) /* print decimal integer, return # of digits printed */
{int a;
if (a = i/10) a = fp5 (a, fd);
else a = 0;
cputc (i%10 + '0', fd);
return (a+1);
}
int fp6 (i, n, fd) /* print decimal integer given # of digits */
{if (n>0)
{if (n>1) fp6 (i/10, n-1, fd);
cputc (i%10 + '0', fd);
}
}

78
src/clib/getsrv.c Normal file
View File

@@ -0,0 +1,78 @@
# include "c.defs"
/**********************************************************************
GETSRV - Lookup name in table of Arpanet Servers
Currently runs only on ITS machines (needs a particular file).
Requires upper case string.
**********************************************************************/
# define TABLESIZE 10000
int getsrv (s) char *s; /* return -1 if bad */
{static int *p;
int n, *nmtab;
/* first check for decimal host number */
n = atoi (s);
if (n > 0) return (n);
/* if not a number, must search the table of host names */
if (!p) /* host file not read in yet */
{int f, *q, *e;
char *ss;
p = calloc (TABLESIZE);
ss = "sysbin;hosts1 >";
f = copen (ss, 'r', "b");
if (f == OPENLOSS)
{cprint ("Unable to find host table: %s\n", ss);
return (-1);
}
e = p + TABLESIZE;
q = p;
while (!ceof (f) && q<e) *q++ = cgeti (f);
cclose (f);
}
nmtab = p+p[6]; /* name table */
n = *nmtab++;
while (--n >= 0)
{int nte, nm, bp;
nte = *nmtab++;
nm = nte & 0777777; /* index of name in table */
nm = p + nm; /* pointer to name in table */
bp = 0440700000000 | nm; /* byte pointer to name */
if (_gmatch (bp, s)) /* found entry */
{int num;
num = nte >> 18; /* index of numtab entry in table */
if (p[num+2]<0) /* it's a server */
return (p[num]);
return (-1);
}
}
return (-1);
}
_gmatch (bp, s) char *s;
{int c;
while (c = ildb (&bp))
if (c != *s++) return (FALSE);
return (*s == 0);
}
#ifdef testing
main ()
{char buf[100];
int n;
while (TRUE)
{cprint ("Enter name:");
gets (buf);
n = getsrv (buf);
cprint ("Name=%s,Number=%d\n", buf, n);
}
}
#endif

76
src/clib/its.bits Normal file
View File

@@ -0,0 +1,76 @@
/* open modes */
# define UAI 0 /* unit ascii input */
# define UAO 1 /* unit ascii output */
# define BAI 2 /* block ascii input */
# define BAO 3 /* block ascii output */
# define UII 4 /* unit image input */
# define UIO 5 /* unit image output */
# define BII 6 /* block image input */
# define BIO 7 /* block image output */
# define OLD 010 /* open old job only */
/* user variables */
# define UPC 0
# define UTTY 02
# define UUNAME 04
# define UJNAME 05
# define USTOP 07
# define UPIRQ 010
# define UINF 011
# define USV40 013
# define UIPIRQ 014
# define UAPIRQ 015
# define USNAME 016
# define UPICLR 017
# define URUNT 024
# define UHSNAME 043
# define UOPTION 054
# define USUPPR 065
# define UXUNAME 074
# define UXJNAME 075
/* USTOP magic bit */
# define BUSRC 0100000000000
/* .OPTION bits */
# define OPTBRK 020000000000 /* can handle .BREAKs */
# define OPTCMD 040000000000 /* got command arg to give */
# define OPTOPC 000200000000 /* always reset PC on interrupt */
/* first word interrupt bits */
# define PJRLT 0200000000000 /* Real-time timer went off [3] (A) */
# define PJRUN 0100000000000 /* Run-time timer went off [3] (A) */
# define PJTTY 02000000000 /* Don't have TTY [2] (S) */
# define PJPAR 01000000000 /* Memory parity error [1] (A) */
# define PJFOV 0400000000 /* ARFOV (Floating overflow) [3] (S) */
# define PJWRO 0200000000 /* WIRO (Write in read-only page) [2] (S) */
# define PJFET 0100000000 /* Fetched insn from impure page [2] (S) */
# define PJTRP 040000000 /* SYSUUO (System uuo in trap mode) [2] (S) */
# define PJDBG 02000000 /* System being debugged state change [3] (A) */
# define PILOS 01000000 /* .LOSE */
# define PICLI 0400000 /* CLI interrupt [3] (A) */
# define PIPDL 0200000 /* PDL overflow [3] (S) */
# define PILTP 0100000 /* 340 or E&S light pen hit [3] (A) */
# define PIMAR 040000 /* MAR hit. [2] (S) */
# define PIMPV 020000 /* MPV (memory protect violation) [2] (S) */
# define PICLK 010000 /* Slow (1/2 sec) clock [3] (A) */
# define PI1PR 04000 /* Single-instruction proceed [1] (S) */
# define PIBRK 02000 /* .BREAK instruction executed. [1] (S) */
# define PIOOB 01000 /* Address out of bounds [2] (S) */
# define PIIOC 0400 /* IOCERR (I/O channel error) [2] (S) */
# define PIVAL 0200 /* .VALUE instruction executed [1] (S) */
# define PIDWN 0100 /* System-going-down status change [3] (A) */
# define PIILO 040 /* ILOPR, ILUUO (illegal operation) [2] (S) */
# define PIDIS 020 /* Display memory protect [2] (A) */
# define PIARO 010 /* Arithmetic overflow [3] (S) */
# define PIB42 04 /* BADPI (Bad location 42) [1] (S) */
# define PICZ 02 /* ^Z or CALL typed on terminal [1] (A) */
# define PITYI 01 /* TTY input (obsolete) [3] (A) */
# define IBACKUP (PJTTY|PJWRO|PJFET|PJTRP|PIMPV|PIOOB|PIIOC|PIILO)
/* interrupts where PC may need SOSing */

282
src/clib/maklib.c Normal file
View File

@@ -0,0 +1,282 @@
# include "c.defs"
# include "its.bits"
/*
MAKLIB
*ITS*
Shared C Library Construction Program
Loads library stuff from TS CLIB into an inferior. Writes
pure part as a sharable file. Constructs a MIDAS program
to load the impure part and define all symbols.
*** Instructions for constructing a new version of the
shared C library:
1. Edit the file MKCLIB STINKR to contain all of the
files you want to be in the library. See that file
for further instructions.
2. Create a TS CLIB in the C directory by running Stinkr on
MKCLIB STINKR.
3. Create a TS MAKLIB using MAKLIB STINKR.
4. Run TS MAKLIB.
The STINKR files are kept in C10LIB.
*/
# define MAXSYMS 4000 /* maximum number of symbols */
# define NAMMASK 0037777777777 /* name mask away flags */
# define SYMMASK 0037777777777 /* symtab mask for name */
struct _syment {int sym, val;};
typedef struct _syment syment;
syment symtab[MAXSYMS];
syment *csymp, *esymp;
main (argc, argv) char *argv[];
{int flib, fmak, version, nam, val, npage, pgno, zeroc;
int j, jch, pch, ilo, ihi, plo, phi, count;
char svers[20], buf[50], vbuf[100];
filespec ff;
syment *p;
/* open library program file */
pch = fopen ("TS CLIB", UII);
if (pch < 0)
{puts ("Unable to find TS CLIB");
return;
}
/* create an inferior job */
j = j_create (020);
if (j < 0)
{puts ("Unable to create inferior job");
return;
}
j_name (j, &ff);
jch = open (&ff, UII);
if (jch < 0)
{puts ("Unable to open inferior job");
return;
}
/* load CLIB program into inferior */
if (sysload (jch, pch))
{puts ("Unable to load TS CLIB");
return;
}
rsymtab (pch);
flib = copen ("c/[clib].>", 'w', "b");
if (flib < 0)
{puts ("Unable to create library file");
return;
}
filnam (itschan (flib), &ff);
version = ff.fn2;
c6tos (version, svers);
apfname (buf, "c/[cmak].foo", svers);
fmak = copen (buf, 'w');
if (fmak < 0)
{puts ("Unable to create maker file");
cclose (flib);
delete ("c/clib.>");
return;
}
cprint ("Creating C library version %s\n", svers);
cprint (fmak, ";\tSHARED C LIBRARY MAKER -- VERSION %s\n\n", svers);
cprint (fmak, ".INSRT C;NC INSERT\n");
cprint (fmak, "TITLE CLIB C LIBRARY VERSION %s\n\n", svers);
p = symtab;
while (p < csymp)
{nam = p->sym;
val = p->val;
++p;
prname (nam, fmak, 0);
cprint (fmak, "\"=%o\n", val);
}
cputc ('\n', fmak);
/* now define impure area */
ilo = jread (lookup (rdname ("SEG0LO")), jch);
ihi = jread (lookup (rdname ("SEG1HI")), jch);
count = ihi - ilo + 1;
cprint (fmak, "\t.IDATA\n\n");
zeroc = 0;
access (jch, ilo);
while (--count >= 0)
{val = uiiot (jch);
if (val)
{if (zeroc>0) cprint (fmak, "\tBLOCK\t%o\n", zeroc);
zeroc = 0;
cprint (fmak, "\t%o\n", val);
}
else ++zeroc;
}
if (zeroc>0) cprint (fmak, "\tBLOCK\t%o\n", zeroc);
cputc ('\n', fmak);
plo = jread (lookup (rdname ("SEG2LO")), jch);
phi = jread (lookup (rdname ("SEG3HI")), jch);
phi =+ 0100;
plo =& ~01777;
npage = (phi - plo + 02000) >> 10;
pgno = plo >> 10;
cprint (fmak, "IPATCH\": BLOCK 40\n\
.CODE\n\
INIT\": MOVEI P,ARGV\n\
PUSHJ P,MAPIN\"\n\
MOVEI A,ZMAIN\"\n\
HRRM A,CALLER\"\n\
GO START\"\n\n\
MAPIN: .CALL [SETZ\n\
SIXBIT/OPEN/\n\
1000,,1 ; CHANNEL 1\n\
[SIXBIT/DSK/]\n\
[SIXBIT/[CLIB]/]\n\
[SIXBIT/%s/]\n\
SETZ [SIXBIT/C/]\n\
]\n\
.VALUE [ASCIZ/: UNABLE TO GET LIBRARY FILE /]\n\
MOVE A,[-%d.,,%o]\n\
.CALL [SETZ\n\
'CORBLK\n\
1000,,200000 ; READ-ONLY\n\
1000,,-1 ; PUT IN MY MAP\n\
A ; AOBJN POINTER\n\
401000,,1 ; FROM FILE\n\
]\n\
.VALUE [ASCIZ/: UNABLE TO MAP IN LIBRARY FILE /]\n\
.CLOSE 1,\n\
POPJ P,\n\n\
MAPOUT\":MOVE A,[-%d.,,%o]\n\
.CALL [SETZ\n\
'CORBLK\n\
1000,,0 ; DELETE\n\
1000,,-1 ; FROM ME\n\
400000,,A ; AOBJN POINTER\n\
]\n\
.VALUE [ASCIZ/: CAN'T MAP OUT LIBRARY PAGES /]\n\
POPJ P,\n\n\
SINIT\": MOVE A,[PUSHJ P,MAPIN]\n\
MOVEM A,ISTART\"\n\
MOVE A,[PUSHJ P,MAPOUT]\n\
MOVEM A,IDONE\"\n\
GO LINIT\"\n\n", svers, npage, pgno, npage, pgno);
cprint (fmak, ".PDATA\NEND INIT\n");
cclose (fmak);
count = phi - plo + 1;
count = (count + 01777) & ~01777;
access (jch, plo);
while (--count >= 0)
{val = uiiot (jch);
cputi (val, flib);
}
cclose (flib);
fmak = copen (vbuf, 'w', "s");
cprint (fmak, ":KILL\r:MIDAS C;[CREL] %s _ C;[CMAK] %s\r", svers, svers);
cclose (fmak);
valret (vbuf);
}
int jread (loc, jch)
{access (jch, loc);
return (uiiot (jch));
}
/**********************************************************************
SYMBOL TABLE
**********************************************************************/
rsymtab (ch)
{int count;
csymp = symtab;
esymp = symtab + MAXSYMS;
uiiot (ch);
count = -((uiiot (ch) >> 18) | 0777777000000) / 2;
uiiot (ch);
uiiot (ch);
--count;
while (--count >= 0)
{int n, val;
n = uiiot (ch) & SYMMASK;
val = uiiot (ch);
csymp->sym = n;
csymp->val = val;
++csymp;
}
}
int lookup (sym)
{syment *p;
for (p = symtab; p < csymp; ++p)
if (p->sym == sym) return (p->val);
puts ("symbol missing");
return (01000000);
}
char tab40[] {' ', '0', '1', '2', '3', '4', '5', '6', '7', '8', '9',
'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J', 'K',
'L', 'M', 'N', 'O', 'P', 'Q', 'R', 'S', 'T', 'U', 'V',
'W', 'X', 'Y', 'Z', '.', '$', '%'};
rdname (p) char *p;
{int w, factor, c;
char *s;
s = p;
w = 0;
factor = (40*40*40*40*40);
while (c = *s++)
{int i;
if (c==' ') continue;
if (factor == 0) continue;
if (c>='a' && c<='z') c =+ ('A'-'a');
for (i=0;i<40;++i)
if (c == tab40[i])
{w =+ (i * factor);
factor =/ 40;
break;
}
if (i>=40) break;
}
return (w);
}
prname (n, fn, w)
{n =& NAMMASK;
if (n) p40 (n, fn);
}
p40 (i, fn)
{int a;
if (a = i/40) p40 (a, fn);
i =% 40;
if (i) cputc (tab40[i], fn);
}

7
src/clib/maklib.stinkr Normal file
View File

@@ -0,0 +1,7 @@
x clib
l maklib
l apfnam
l c10job
l c10fnm
o ts maklib


93
src/clib/match.c Normal file
View File

@@ -0,0 +1,93 @@
# include "c.defs"
/**********************************************************************
SMATCH - pattern matching procedure
The pattern P is a character string which is to be matched
with the data string S. Certain characters in P are treated
special:
'*' match any substring
'?' match any character
'\\' quote following character
**********************************************************************/
int smatch (p, s)
char *p;
char *s;
{int c1, c2, i;
while (TRUE)
{c1 = *p++;
c2 = *s++;
switch (c1) {
case 0: return (!c2);
case '?': if (!c2) return (FALSE);
continue;
case '*': while (*p=='*') ++p;
if (*p==0) return (TRUE);
i = -1;
do if (smatch (p, s+i)) return (TRUE);
while (s[i++]);
return (FALSE);
case '\\': if (!(c1 = *p++)) return (FALSE);
/* fall through */
default: if (c1 != c2) return (FALSE);
continue;
}
}
}
/**********************************************************************
SINDEX (P, DS)
Return the index of the first occurrence of the string P
in the string DS. Return -1 if P does not occur in DS.
**********************************************************************/
int sindex (p, ds)
char *p;
char *ds;
{int c1, c2, start;
char *s, *t1, *t2, *tail;
s = ds;
start = p[0];
tail = p+1;
if (start) while (TRUE)
{while ((c2 = *s++) != start)
if (c2==0) return (-1);
t1 = tail;
t2 = s;
while ((c1 = *t1++) == (c2 = *t2++))
if (c1==0) break;
if (c1==0) break;
}
return (s-ds-1);
}
# ifdef test
int main ()
{char buf1[100], buf2[100];
while (TRUE)
{cprint ("Pattern: ");
gets (buf1);
cprint ("Data: ");
gets (buf2);
if (smatch (buf1, buf2))
cprint ("Matched.\n");
else cprint ("No match.\n");
}
}
# endif

29
src/clib/mkclib.stinkr Normal file
View File

@@ -0,0 +1,29 @@
; Stinkr xfile for loading basic C library in preparation for construction
; of the shared library.
; note -- it is proper for ZMAIN to be undefined
; note -- it is proper for DATE to have 3 TOPS-20-related names undefined
; The last two addresses in the 's' command must be set so that nothing
; overlaps and there is no wraparound. You also have to leave some room
; at the end for consing done during loading.
; The best procedure is to first use 'p' for the last two numbers, which
; tells Stinkr to allocate from the next page boundary. Then run Stinkr
; to find out how big the segments are. Then you can change the starting
; addresses to push the last to segments as close to the end as possible.
; You should leave about 400 octal words for cons space; if you have not
; left enough, stinker will die saying LBINIT failed.
; If the library has gotten bigger (more pages), the program C10SAV must
; be changed accordingly.
; C10SRY should not be here; you want to run it before the library is mapped
; in.
; C10SAV should not be here; it maps out the library as it runs.
s 100,n,755400,774000
i lbinit
o ts clib
x c;clib prglst

56
src/clib/pr60th.c Normal file
View File

@@ -0,0 +1,56 @@
# include "c.defs"
/**********************************************************************
PR60TH - Print time in 1/60 sec.
Print time HH:MM:SS.XX on file FILE.
TIME is in units of 1/60 sec.
**********************************************************************/
pr60th (time, file)
{int ss, sc, mn, hour, zs;
if (time < 0) time = -time;
zs = TRUE;
ss = time%60;
time = time/60;
sc = time%60;
time = time/60;
mn = time%60;
hour = time/60;
if (hour)
{cprint (file, "%3d:", hour);
zs = FALSE;
}
else cprint (file, " ");
xput2 (mn, file, zs);
if (zs && mn==0) cputc (' ', file);
else
{cputc (':', file);
zs = FALSE;
}
if (zs && !sc)
{cputc (' ', file);
cputc ('0', file);
}
else
{xput2 (sc, file, zs);
zs = FALSE;
}
cputc ('.', file);
xput2 (ss, file, FALSE);
}
xput2 (val, file, zs)
{int num;
num = val/10;
if (num>0 || !zs) {cputc ('0'+num, file); zs=FALSE;}
else cputc (' ', file);
num = val%10;
if (num>0 || !zs) cputc ('0'+num, file);
else cputc (' ', file);
}

31
src/clib/random.cmid Normal file
View File

@@ -0,0 +1,31 @@
;
; RANDOM - RANDOM NUMBER GENERATOR (STOLEN FROM MUDDLE)
;
; This file is PDP-10 dependent, system-independent.
;
TITLE RANDOM
.INSRT NC
.INSRT NM
CENTRY SRAND,[SEED]
MOVE A,SEED
ROT A,-1
MOVEM A,RLOW
RETURN
CENTRY RAND
MOVE A,RHI
MOVE B,RLOW
MOVEM A,RLOW ;Update Low seed
LSHC A,-1 ;Shift both right one bit
XORB B,RHI ;Generate output and update High seed
MOVE A,B
RETURN
.IDATA
RHI: 267762113337
RLOW: 155256071112
.PDATA
END

248
src/clib/stkdmp.c Normal file
View File

@@ -0,0 +1,248 @@
# include "c.defs"
/**********************************************************************
STKDMP - C Stack Dumping Routine
This file is PDP-10 dependent, but essentially system
independent.
**********************************************************************/
# rename findproc "FINDPR"
# rename findframe "FINDFR"
# rename print_name "PRNAME"
# rename callok "CALLOK"
# rename hack "STKDMP"
# rename seg2lo "SEG2LO"
# rename seg2hi "SEG2HI"
# rename seg3lo "SEG3LO"
# rename seg3hi "SEG3HI"
# rename pdlbot "PDLBOT"
# rename pdltop "PDLTOP"
# rename purbot "PURBOT"
# rename purtop "PURTOP"
# rename intptr "INTPTR"
# rename mpvh "MPVH"
# rename etsint "ETSINT"
# rename uuoh "UUOH"
# rename uuohan "UUO$HA"
# rename euuoh "EUUOH"
# rename caller "CALLER"
# define ADDI_P 0271740
# define SUBI_P 0275740
# define GO_P 0254037
# define JSP_D 0265200
# define GO 0254000
# define left(x) (((x) >> 18) & 0777777)
# define right(x) ((x) & 0777777)
extern int *seg2lo, *seg2hi, *seg3lo, *seg3hi,
*pdlbot, *pdltop, *purbot, *purtop, *caller,
mpvh[], etsint[], intptr, uuoh[], uuohan[], euuoh[],
cout, *findframe(), *findproc(), hack[];
/**********************************************************************
STKDMP - Dump stack.
**********************************************************************/
static int tuuoh;
stkdmp (fd)
{int *pc; /* procedure pointer */
int *opc; /* previously printed-out pc */
int *sp; /* stack pointer */
if (!cisfd(fd)) fd = cout;
cputc ('\n', fd);
tuuoh = uuoh[0];
sp = &fd; /* arg is on the stack */
pc = right(sp[1]); /* my caller's pc is on the stack */
opc = -1;
--sp; /* top of stack when he was running */
if (pc >= hack && pc <= hack+12) /* PUSHJ P,STKDMP$X */
{pc = right(sp[0]); /* 'real' caller */
sp =- 7; /* 'real' stack top */
}
while (TRUE)
{int *proc, nargs, *npc, *namep, *ap;
proc = findproc (pc);
if (proc == 0) break;
nargs = left(proc[-1]);
namep = right(proc[-1]);
sp = findframe (sp, proc, pc);
if (sp == 0)
{if (opc != caller)
{cprint (fd, " ");
print_name (namep, fd);
cprint (fd, "\n");
}
break;
}
npc = right(sp[0]);
sp =- nargs;
ap = sp;
--sp;
cprint (fd, "%7o ", sp);
print_name (namep, fd);
cprint (fd, " (");
if (nargs>10) nargs = 10;
while (--nargs >= 0)
{cprint (fd, "%o", *ap++);
if (nargs) cprint (fd, ", ");
}
cprint (fd, ")\n");
opc = proc;
pc = npc;
}
}
/**********************************************************************
FINDPROC - Find beginning of active procedure, given a PC.
**********************************************************************/
int *findproc (pc) int *pc;
{int *low, *high, n;
n = 3;
while (--n>=0)
{if (pc >= mpvh && pc < etsint)
{int *p;
p = right(intptr);
pc = right(p[-4]);
continue;
}
if (pc == uuoh+1 || (pc >= uuohan && pc < euuoh))
{pc = right(tuuoh);
if ((pc[0]>>29)==0) ++pc; /* hack */
continue;
}
}
if (pc > seg2lo && pc <= seg2hi)
{low = seg2lo;
high = seg2hi;
}
else if (pc > purbot && pc <= purtop)
{low = purbot;
high = purtop;
}
else return (0);
++pc;
while (--pc > low)
{int data, c, nargs, *namep;
if ((*pc >> 27) == 0) continue;
data = pc[-1];
nargs = left(data);
namep = right(data);
if (nargs >= 16) continue;
if (namep < seg3lo || namep > seg3hi) continue;
c = (*namep >> 29); /* left byte */
if (c < ' ' || c > 'z') continue;
return (pc);
}
return (0);
}
/**********************************************************************
FINDFRAME - Find stack frame, given stack top and procedure
pointer, and PC within procedure. Returns pointer
to return address on stack.
**********************************************************************/
int *findframe (sp, proc, pc) int *sp, *proc, *pc;
{int instr, signal();
instr = proc[0];
if (left(instr) == ADDI_P) /* procedure allocates a frame */
{int bump;
bump = right(instr); /* local frame size */
if (pc == proc); /* hasn't allocated it yet */
else if (left(pc[0]) == GO_P); /* has popped it */
else sp =- bump;
}
if (pc >= mpvh && pc < etsint) /* was in interrupt handler */
sp =- 17; /* ignore stuff pushed by handler */
/* !!! the above is wrong !!! */
++sp;
while (--sp >= pdlbot)
{int data, *opc;
data = *sp;
/* look for return address word on stack */
/* check for reasonable status bits */
if (!(data & 0010000000000)) continue;
/* must be in user mode */
if (data & 0027637000000) continue; /* bad for status bits */
/* check for reasonable old PC (within code segment) */
opc = right(data) - 1;
if (opc < seg2lo) continue;
if (opc > seg2hi) continue;
/* check to see if old PC was call to current proc */
if (callok (opc, proc))
{if (proc == signal && opc>=mpvh && opc<etsint)
tuuoh = sp[-1];
return (sp);
}
}
return (0);
}
/**********************************************************************
CALLOK
**********************************************************************/
int callok (opc, proc)
int *opc, *proc;
{int call, *tpc, op;
call = *opc;
if (call & 037000000) /* index or indirect */
return (TRUE); /* can't test it, assume it's the right one */
op = left(call); /* op code */
tpc = right(call); /* address */
if (op == JSP_D) /* call with nargs mismatch */
{int n, i; /* look for jump */
n = 20; /* up to 20 instructions before jump */
for (i=0;i<n;++i)
{call = tpc[i];
op = left(call);
if (op == GO)
{tpc = right(call);
break;
}
}
}
return (tpc == proc);
}
/**********************************************************************
PRINTNAME
**********************************************************************/
print_name (namep, fd)
{int c;
namep = right(namep) | 0440700000000;
while (c = ildb (&namep))
cputc (c>='A' && c<='Z' ? c+('a'-'A') : c, fd);
}

131
src/clib/string.cmid Normal file
View File

@@ -0,0 +1,131 @@
;
; STRING - C STRING, BYTE, AND BIT ROUTINES
;
; This file is PDP-10 dependent, system-independent.
;
TITLE STRING
.INSRT NC
.INSRT NM
; CONTAINS:
; SLEN ; STRING LENGTH
; STCPY ; STRING COPY
; STCMP ; STRING COMPARE
; LOWER ; CVT CHAR TO LOWER CASE
; UPPER ; CVT CHAR TO UPPER CASE
; BGET ; BIT ARRAY BIT GET
; BSET ; BIT ARRAY BIT SET
; ILDB ; INCREMENT AND LOAD BYTE
; IDPB ; INCREMENT AND DEPOSIT BYTE
CENTRY SLEN,[STR] ; STRING LENGTH
MOVE B,STR ; POINTER TO STRING
SETZ A, ; COUNTER
SL$1: MOVE C,(B) ; GET NEXT CHARACTER
SKIPN C
GO SL$RET ; RETURN ON NULL CHAR
ADDI A,1 ; INCR COUNTER
ADDI B,1 ; INCR POINTER
GO SL$1
SL$RET: RETURN
CENTRY STCPY,[SRC,DEST] ; STRING COPY
; COPY STRING FROM SRC TO DEST
; RETURN POINTER TO NULL TERMINATING NEW COPY
MOVE B,SRC ; SOURCE POINTER
MOVE A,DEST ; DESTINATION POINTER
SC$1: MOVE C,(B) ; GET NEXT CHAR
MOVEM C,(A) ; STORE
SKIPN C
GO SC$RET ; RETURN AFTER WRITING NULL CHAR
ADDI B,1 ; INCR SOURCE PTR
ADDI A,1 ; INCR DESTINATION PTR
GO SC$1
SC$RET: RETURN
CENTRY STCMP,[S1,S2] ; STRING COMPARE
MOVE B,S1
MOVE C,S2
SM$1: MOVE A,(B) ; GET NEXT CHAR
CAME A,(C)
GO SM$2 ; DIFFERENCE FOUND
ADDI B,1 ; INCR PTR1
ADDI C,1 ; INCR PTR2
JUMPN A,SM$1
SETO A,
GO SM$RET
SM$2: SETZ A,
SM$RET: RETURN
CENTRY LOWER,[CH] ; CVT CHAR TO LOWER CASE
MOVE A,CH
CAIGE A,"A
GO LW$RET
CAILE A,"Z
GO LW$RET
ADDI A,"a-"A
LW$RET: RETURN
CENTRY UPPER,[CH] ; CVT CHAR TO UPPER CASE
MOVE A,CH
CAIGE A,"a
GO UP$RET
CAILE A,"z
GO UP$RET
SUBI A,"a-"A
UP$RET: RETURN
CENTRY BGET,[BARRAY,BINDEX] ; BIT ARRAY BIT GET
HRRZ C,BINDEX
HRRZ A,BARRAY
MOVEI B,(C) ; SUBSCRIPT
LSH C,-5 ; GET WORD OFFSET
ADDI A,(C) ; GET WORD ADDRESS
MOVE A,(A) ; GET THE WORD
ANDI B,37 ; BIT OFFSET
ROT A,1(B) ; PUT BIT IN RIGHT-MOST POSITION
ANDI A,1 ; GET THE BIT
RETURN
CENTRY BSET,[BARRAY,BINDEX] ; BIT ARRAY BIT SET
HRRZ C,BINDEX
HRRZ A,BARRAY
MOVEI B,(C) ; SUBSCRIPT
LSH C,-5 ; GET WORD OFFSET
ADDI A,(C) ; GET WORD ADDRESS
ANDI B,37 ; BIT OFFSET
MOVN B,B ; NEGATIVE BIT OFFSET
MOVEI C,1 ; A BIT
ROT C,-1(B) ; PUT IN RIGHT POSITION
IORM C,(A) ; SMASH ARRAY WORD
MOVEI A,1
RETURN
CENTRY ILDB,[ABPTR] ; INCREMENT AND LOAD BYTE
HRRZ A,ABPTR ; ADDRESS OF BYTE POINTER
ILDB A,(A)
RETURN
CENTRY IDPB,[CH,ABPTR] ; INCREMENT AND DEPOSIT BYTE
MOVE B,CH ; THE CHARACTER
HRRZ A,ABPTR ; ADDRESS OF BYTE POINTER
IDPB B,(A)
RETURN
END

18
src/clib/tstfd.c Normal file
View File

@@ -0,0 +1,18 @@
/**********************************************************************
TSTFD
Test routine for FD
**********************************************************************/
main ()
{char buf[200];
extern int puts ();
for (;;)
{cprint ("Enter pattern: ");
gets (buf);
fdmap (buf, puts);
puts ("");
}
}

123
src/clib/ttime.c Normal file
View File

@@ -0,0 +1,123 @@
/**********************************************************************
TTIME - Test program for Timing
**********************************************************************/
# rename timing "TIMING"
extern int timing;
main ()
{int i;
i = 10000;
if (timing) i = 1000;
while (--i >= 0) foo ();
}
foo () /* calls null 100 times */
{
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
}
null () {;}

156
src/clib/uuoh.cmid Normal file
View File

@@ -0,0 +1,156 @@
;
; UUOH - C UUO Handler
;
; This file is PDP-10 dependent, system-independent.
;
TITLE UUOH
.INSRT NC
.INSRT NM
;
; UUO DISPATCH TABLE
;
.PDATA
IENTRY UUOTAB
ILLUUO
UCCALL ;.CCALL - FIRST TIME CALL
UVCALL ;.VCALL - CALL OF VARIABLE PROC
UACALL ;.ACALL - CALL NEEDING ADDITIONAL ARGS
UXCALL ;.XCALL - CALL WITH EXTRA ARGS
REPEAT UUOTAB+40-.,[ILLUUO?]
;
; BASIC UUO DISPATCHER
;
.IDATA
MDATA UUOH
0
GO UUO$HANDLER
MDATA SMASH
-1
.UDATA
MDATA USAVEA
BLOCK 1
MDATA USAVEB
BLOCK 2
MDATA USAVEC
BLOCK 3
MDATA USAVED
BLOCK 4
.CODE
IENTRY UUO$HANDLER
MOVEM D,USAVED
LDB D,[330500,,40] ; GET UUO CODE
GO @UUOTAB(D) ; DISPATCH BASED ON THE UUO
URETA: MOVE A,USAVEA
URETB: MOVE B,USAVEB
URETC: MOVE C,USAVEC
URETD: MOVE D,USAVED
GO @UUOH
;
; ILLEGAL UUO HANDLER
;
IENTRY ILLUUO
CROAK ILLEGAL UUO
GO URETD
;
; .CCALL HANDLER
;
IENTRY UCCALL
MOVEM B,USAVEB ; MUST NOT CHANGE ANY REGS
MOVEM C,USAVEC ; AS CALL MIGHT BE THRU A REG
HRRZ C,40 ; THE CALLED PROCEDURE
JUMPE C,UCBAD ; NO SUCH PROCEDURE
HLRZ 0,-1(C) ; THE NUMBER OF FORMAL ARGS
CAIL 0,20 ; REASONABLE NUMBER?
GO UCBAD ; NO, NOT A PROCEDURE
SKIPN SMASH ; SHOULD I SMASH THE CALL
GO UC$GO ; NO, LEAVE IT
SOS D,UUOH ; ADDRESS OF THE CALL
MOVE B,(D) ; THE .CCALL INSTRUCTION
TLZ B,777740 ; ZERO OUT ALL BUT ADDRESS PART
CAIE B,(C) ; IS IT A CONSTANT CALL?
GO UCV ; NO, CHANGE IT INTO A .VCALL
LDB B,[270400,,40] ; THE NUMBER OF ACTUAL ARGS
HLRZ 0,-1(C) ; THE NUMBER OF FORMAL ARGS
SUB B,0 ; THE NUMBER OF EXTRA ACTUALS
JUMPL B,UCA ; TOO FEW ACTUALS
JUMPG B,UCX ; TOO MANY ACTUALS
MOVEI B,(PUSHJ P,)
HRLM B,(D) ; SMASH .CCALL TO PUSHJ
GO URETB ; RE-EXECUTE CALL
UCA: MOVN B,B ; THE NUMBER OF EXTRA ARGS NEEDED
LSH B,5 ; SHIFT INTO ACCUMULATOR POSITION
IORI B,(.ACALL)
HRLM B,(D) ; SMASH .CCALL TO .ACALL
GO URETB ; RE-EXECUTE CALL
UCX: LSH B,5 ; SHIFT INTO ACCUMULATOR POSITION
IORI B,(.XCALL)
HRLM B,(D) ; SMASH .CCALL TO .ACALL
GO URETB ; RE-EXECUTE CALL
UCV: MOVE B,(D) ; THE ORIGINAL CALL
TLZ B,777000 ; MASK OUT OPCODE
TLO B,(.VCALL) ; MAKE IT A .VCALL
MOVEM B,(D) ; SMASH CALL
GO URETB ; RE-EXECUTE CALL
IENTRY UCBAD
LDB B,[270400,,0] ; THE NUMBER OF ACTUAL ARGS
UVBAD: MOVEM B,USAVEA ; SAVE NUMBER OF ACTUAL ARGS
SETZ A, ; SET DEFAULT RETURN VALUE
MOVE D,UUOH
SUBI D,1 ; LET USER LOOK AT CALL
CROAK CALL OF UNDEFINED PROCEDURE
SUB P,USAVEA ; POP OFF ARGS
GO URETB ; RETURN TO CALLER
IENTRY UVCALL
HRRZ C,40 ; THE CALLED PROCEDURE
JUMPE C,UVBAD ; NO SUCH PROCEDURE
HLRZ 0,-1(C) ; THE NUMBER OF FORMAL ARGS
CAIL 0,20 ; REASONABLE NUMBER?
GO UVBAD ; NO, NOT A PROCEDURE
UC$GO: LDB B,[270400,,40] ; THE NUMBER OF ACTUAL ARGS
SUB 0,B ; NUMBER OF ARGS NOT GIVEN
JUMPL 0,UVHACK ; TOO MANY ARGS GIVEN
UVLOOP: SOJL 0,UVDOIT ; FOR EACH ARG NEEDED
PUSH P,[0] ; PUSH ZERO ARG
GO UVLOOP ; LOOP
UVHACK: ; TOO MANY ARGS GIVEN
ADD P,0 ; POP OFF EXTRA ARGS
UVDOIT: PUSH P,UUOH ; PUSH RETURN ADDRESS
GO (C) ; EXECUTE PROCEDURE
IENTRY UACALL
LDB B,[270400,,40] ; THE NUMBER OF EXTRA ARGS NEEDED
HRRZ C,40 ; THE CALLED PROCEDURE
UALOOP: SOJL B,UVDOIT ; FOR EACH ARG NEEDED
PUSH P,[0] ; PUSH ZERO ARG
GO UALOOP ; LOOP
IENTRY UXCALL
LDB B,[270400,,40] ; THE NUMBER OF EXTRA ARGS
HRRZ C,40 ; THE CALLED PROCEDURE
SUBI P,(B) ; POP OFF EXTRA ARGS
PUSH P,UUOH ; PUSH RETURN ADDRESS
GO (C) ; EXECUTE PROCEDURE
IENTRY EUUOH
END