diff --git a/Makefile b/Makefile index 5ca66f5e..e79583b8 100644 --- a/Makefile +++ b/Makefile @@ -31,7 +31,7 @@ DOC = info _info_ sysdoc sysnet syshst kshack _teco_ emacs emacs1 c kcc \ chprog sail draw wl pc tj6 share _glpr_ _xgpr_ inquir mudman system \ xfont maxout ucode moon acount alan channa fonts games graphs humor \ kldcp libdoc lisp _mail_ midas quux scheme manual wp chess ms macdoc \ - aplogo _klfe_ pdp11 chsncp cbf rug bawden llogo eak + aplogo _klfe_ pdp11 chsncp cbf rug bawden llogo eak clib BIN = sys2 emacs _teco_ lisp liblsp alan inquir sail comlap c decsys \ graphs draw datdrw fonts fonts1 fonts2 games macsym maint imlac \ _www_ hqm gt40 llogo bawden diff --git a/doc/clib/clib.list b/doc/clib/clib.list new file mode 100644 index 00000000..6171101c --- /dev/null +++ b/doc/clib/clib.list @@ -0,0 +1,207 @@ +/* + + CLIB LIST - List of some C routines contained in the + shared library. + + *** TYPE DEFINITIONS *** + +1. SIXBIT A word containing left-justified SIXBIT + characters. + +2. FILESPEC A block of four SIXBIT words, representing + an ITS file specification. + +*/ + +# define sixbit int + +struct _filespec {sixbit dev, fn1, fn2, dir;}; +# define filespec struct _filespec + +/********************************************************************** + + PARAMETER AND RETURNED VALUE TYPE DEFINITIONS + +*/ + +char c; /* an ASCII character */ +int i; /* an integer */ +int *p; /* an integer pointer */ +int b; /* a boolean */ +char *s, *s1, *s2; /* strings */ +int rc; /* a return code, + zero if OK, non-zero otherwise */ +char *fn; /* a string representing an ITS file + name or a path name */ +int fd; /* a "file descriptor," used by the + portable I/O stuff */ + +char c6; /* a SIXBIT character */ +sixbit w; /* a SIXBIT word */ +filespec *f; /* a pointer to a FILESPEC block */ +int ch; /* an ITS channel or (returned) negative + ITS failure code */ +int fdate; /* date as stored in ITS file dir */ +int pg; /* a page number */ +int *pbp; /* pointer to a PDP-10 byte pointer */ + +/********************************************************************** + + A LISTING OF THE ROUTINES + +*/ + + /* "Portable" I/O Routines */ + +fd = copen (fn, mode, options); /* open file */ + /* mode is either + 'r' - read + 'w' - write + 'a' - append + options is usually omitted + but "s" means I/O to string (pass string as fn) + and "b" means binary I/O + returns -1 if open fails + */ + +extern int cin; /* standard input - pre-existing */ +extern int cout; /* standard output - pre-existing */ +extern int cerr; /* standard error ouput - pre-existing */ + +c = cgetc (fd); /* get character; returns 0 if eof */ +c = cputc (c, fd); /* put character */ +b = ceof (fd); /* test for end of file */ +cclose (fd); /* close file */ + +c = getchar (); /* equivalent to cgetc(cin) */ +putchar (c); /* equivalent to cputc(c,cout) */ + +gets (s1); /* read string (line) from cin */ +puts (s1); /* put string and newline to cout */ + +cprint (fd, format, arg...); /* formatted print routine */ + /* the format is a string which may contain format items + of the form %nf, where n is an optional decimal integer + (the minimum field width) and f is one of the following + characters: + + d - print next arg (an integer) in decimal + o - print next arg (an integer) in octal + s - print next arg (a string) + c - print next arg (a character) + + The file descriptor FD can be omitted, in which case + COUT is used. + */ + +i = cgeti (fd); /* get integer (binary input) */ +i = cputi (i, fd); /* put integer (binary output) */ + +cexit (cc); /* terminate job, closing all files */ + /* returning from "main" is equivalent */ + +b = istty (fd); /* test if file is a TTY */ +ch = itschan (fd); /* return actual ITS channel */ + + /* STRING Routines */ + +i = slen (s); /* find string length */ +stcpy (s1, s2); /* copy string from S1 to S2 */ +b = stcmp (s1, s2); /* compare strings */ + + /* SIXBIT Routines */ + +c6 = ccto6 (c); /* convert ASCII char to SIXBIT char */ +c = c6toc (c6); /* convert SIXBIT char to ASCII char */ +w = csto6 (s1); /* convert ASCIZ string to SIXBIT word */ +c6tos (w, s1); /* convert SIXBIT word to ASCII string */ + + /* ITS Filename Routines */ + +fparse (s1,f); /* convert file name or path name to FILESPEC */ +prfile (f,s1); /* convert FILESPEC to file name (ASCII string) */ + + /* ITS I/O Routines */ + +ch = mopen (f, mode); /* open file, handle TTY specially */ +rc = mclose (ch); /* close channel, unless TTY */ +spctty (c); /* output ^P code to TTY */ + +ch = fopen (s1, mode); /* open channel given filename or pathname, + if error return negative ITS failure code */ +ch = open (f, mode); /* open channel given filespec + if error return negative ITS failure code */ +delete (fname); /* delete the file named FNAME */ + + /* Byte Pointer Hacking */ + +ildb (pbp); +idpb (i, pbp); + + /* Interfaces to ITS System Calls */ + +rc = sysopen (ch, f, mode); /* open specific channel, if error return + negative ITS failure code */ +sysdel (f); /* delete the file specified by F */ +ch = chnloc (); /* find an available channel */ +rc = close (ch); /* close a channel */ +uclose (ch); /* close a job */ +i = status (ch); /* return channel status */ +n = fillen (ch); /* return ITS file length */ +access (ch, i); /* set file access pointer */ +reset (ch); /* reset channel */ +i = uiiot (ch); /* unit input IOT */ +uoiot (ch, i); /* unit output IOT */ +n_read = sysread (ch, p, n_words); /* block input IOT */ +n_written = syswrite (ch, p, n_words); /* block output IOT */ +fdate = rfdate (ch); /* read file creation date */ +fdate = sfdate (ch, fdate); /* set file creation date */ + +w = rsname (); /* return SNAME */ +w = runame (); /* return UNAME */ +ssname (w); /* set SNAME */ +sleep (n); /* sleep for n 30th seconds */ +rc = sysload (job_ch, prog_ch); /* load program into job */ +rc = atty (ch); /* give TTY to inferior */ +rc = dtty (ch); /* take TTY from inferior */ +valret (s); /* .VALUE a string (or 0) */ + +t = etime(); /* return system elapsed time in 1/60 sec units*/ +t = cputm(); /* return job CPU time in 1/60 sec units */ +t = getcpu(); /* return job CPU time in 4.096 usec units */ + +rc = corblk (mode, dest, destpg, src, srcpg); +cortyp (pg, &resultblock); +rc = pageid (idn, pg); + +/* USET hacking */ + +what = rsuset (where); +what = wsuset (where, what); + +what = ruset (who, where); +what = wuset (who, where, what); + +/* TRANSL hacking */ + +rc = tranad (job, from_file_spec, to_file_spec, flags); +rc = trancl (job, flags); +rc = trandl (job, file_spec, flags); + +/* storage allocation */ + +p = salloc (n); /* allocate n words, return pointer to it */ +sfree (p); /* free storage allocated by salloc */ +s = calloc (n); /* allocate n characters, return ptr to it */ +cfree (s); /* free storage allocated by calloc */ + +/* interrupt hacking */ + +previous_handler = on (interrupt_number, new_handler); +signal (interrupt_number); + +/* miscellaneous routines */ + +i = wfnz (p); /* wait for word pointed to by P to become + non-zero; then return that value */ + diff --git a/src/c/code.insert b/src/c/code.insert new file mode 100644 index 00000000..a95e3002 --- /dev/null +++ b/src/c/code.insert @@ -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 diff --git a/src/c/nm.insert b/src/c/nm.insert new file mode 100644 index 00000000..77314588 --- /dev/null +++ b/src/c/nm.insert @@ -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 +&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 diff --git a/src/clib/ac.c b/src/clib/ac.c new file mode 100644 index 00000000..fd40c7a2 --- /dev/null +++ b/src/clib/ac.c @@ -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);} + diff --git a/src/clib/alloc.cmid b/src/clib/alloc.cmid new file mode 100644 index 00000000..48818410 --- /dev/null +++ b/src/clib/alloc.cmid @@ -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 diff --git a/src/clib/apfnam.c b/src/clib/apfnam.c new file mode 100644 index 00000000..f18b9963 --- /dev/null +++ b/src/clib/apfnam.c @@ -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); + } diff --git a/src/clib/ar2.clib b/src/clib/ar2.clib deleted file mode 100644 index f27c43e9..00000000 Binary files a/src/clib/ar2.clib and /dev/null differ diff --git a/src/clib/atoi.c b/src/clib/atoi.c new file mode 100644 index 00000000..e55a9219 --- /dev/null +++ b/src/clib/atoi.c @@ -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); + } diff --git a/src/clib/blt.cmid b/src/clib/blt.cmid new file mode 100644 index 00000000..172aaab0 --- /dev/null +++ b/src/clib/blt.cmid @@ -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 diff --git a/src/clib/c10boo.cmid b/src/clib/c10boo.cmid new file mode 100644 index 00000000..c7eac307 --- /dev/null +++ b/src/clib/c10boo.cmid @@ -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 diff --git a/src/clib/c10cor.cmid b/src/clib/c10cor.cmid new file mode 100644 index 00000000..4541a4fe --- /dev/null +++ b/src/clib/c10cor.cmid @@ -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 diff --git a/src/clib/c10exc.c b/src/clib/c10exc.c new file mode 100644 index 00000000..b052eb00 --- /dev/null +++ b/src/clib/c10exc.c @@ -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)); + } diff --git a/src/clib/c10exp.c b/src/clib/c10exp.c new file mode 100644 index 00000000..4e2092d7 --- /dev/null +++ b/src/clib/c10exp.c @@ -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 (idev; + 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; pfn1) + {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 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 diff --git a/src/clib/c10io.c b/src/clib/c10io.c new file mode 100644 index 00000000..bd9ff33a --- /dev/null +++ b/src/clib/c10io.c @@ -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) + {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)<=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< # 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 */ + 0043100000000, /* .LOSE ;(30) FAIL, CAUSE ERR MSG */ + 0042000000027, /* .DISOWN 0, ;(31) DISOWN */ + 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 && jfn2 = 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; + } + } diff --git a/src/clib/c10map.c b/src/clib/c10map.c new file mode 100644 index 00000000..71f2f5f4 --- /dev/null +++ b/src/clib/c10map.c @@ -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> 10; + no_pages = ((word_no + size - 1) >> 10) + 1; + pg_ret (page_no, no_pages); + } + diff --git a/src/clib/c10mio.cmid b/src/clib/c10mio.cmid new file mode 100644 index 00000000..ea9b917c --- /dev/null +++ b/src/clib/c10mio.cmid @@ -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* ; 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 diff --git a/src/clib/c10pag.c b/src/clib/c10pag.c new file mode 100644 index 00000000..3d943ec2 --- /dev/null +++ b/src/clib/c10pag.c @@ -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) break; /* success */ + page =+ i+1; + } + if (page > top) return (-1); + for (i=0;i256) + {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); + } + diff --git a/src/clib/c10run.cmid b/src/clib/c10run.cmid new file mode 100644 index 00000000..f5851177 --- /dev/null +++ b/src/clib/c10run.cmid @@ -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+-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 diff --git a/src/clib/c10sav.cmid b/src/clib/c10sav.cmid new file mode 100644 index 00000000..12e8c362 --- /dev/null +++ b/src/clib/c10sav.cmid @@ -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 diff --git a/src/clib/c10sfd.c b/src/clib/c10sfd.c new file mode 100644 index 00000000..fef239f7 --- /dev/null +++ b/src/clib/c10sfd.c @@ -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); + } diff --git a/src/clib/c10sry.cmid b/src/clib/c10sry.cmid new file mode 100644 index 00000000..2ded1eff --- /dev/null +++ b/src/clib/c10sry.cmid @@ -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 diff --git a/src/clib/c10std.c b/src/clib/c10std.c new file mode 100644 index 00000000..b327a0d2 --- /dev/null +++ b/src/clib/c10std.c @@ -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);} diff --git a/src/clib/c10sys.cmid b/src/clib/c10sys.cmid new file mode 100644 index 00000000..d6478b2c --- /dev/null +++ b/src/clib/c10sys.cmid @@ -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 diff --git a/src/clib/c10tap.cmid b/src/clib/c10tap.cmid new file mode 100644 index 00000000..8a0dc88b --- /dev/null +++ b/src/clib/c10tap.cmid @@ -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 diff --git a/src/clib/c10tmm.cmid b/src/clib/c10tmm.cmid new file mode 100644 index 00000000..333e6c0a --- /dev/null +++ b/src/clib/c10tmm.cmid @@ -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 diff --git a/src/clib/c10tmr.cmid b/src/clib/c10tmr.cmid new file mode 100644 index 00000000..222ca074 --- /dev/null +++ b/src/clib/c10tmr.cmid @@ -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,/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,/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+ +.UDATA +MDATA TIMTAB + BLOCK TIMSIZ*%TSIZE +MDATA TIMSTK + BLOCK TIMSIZ +END diff --git a/src/clib/c10tpr.c b/src/clib/c10tpr.c new file mode 100644 index 00000000..2ab2581f --- /dev/null +++ b/src/clib/c10tpr.c @@ -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;iptime > ip->time) + bswap (ip, ip1, 4); + + total_time = 0; + for (ip=timtab;iptime; + + ncalls = 0; + smallest = 10000; /* big number */ + ctime = 0; + for (ip=timtab;iptime; + 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 (average0) 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= 0) + {t = *p; + *p++ = *q; + *q++ = t; + } + } + +null () {;} diff --git a/src/clib/c10tty.c b/src/clib/c10tty.c new file mode 100644 index 00000000..25d96747 --- /dev/null +++ b/src/clib/c10tty.c @@ -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=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;} diff --git a/src/clib/cfloat.cmid b/src/clib/cfloat.cmid new file mode 100644 index 00000000..5e00a8c0 --- /dev/null +++ b/src/clib/cfloat.cmid @@ -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 diff --git a/src/clib/clib.h b/src/clib/clib.h new file mode 100644 index 00000000..c26fa2c6 --- /dev/null +++ b/src/clib/clib.h @@ -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 diff --git a/src/clib/clib.prglst b/src/clib/clib.prglst new file mode 100644 index 00000000..abd960da --- /dev/null +++ b/src/clib/clib.prglst @@ -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 + \ No newline at end of file diff --git a/src/clib/clib.tester b/src/clib/clib.tester new file mode 100644 index 00000000..3786ac79 --- /dev/null +++ b/src/clib/clib.tester @@ -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 diff --git a/src/clib/clib.timer b/src/clib/clib.timer new file mode 100644 index 00000000..059dcd85 --- /dev/null +++ b/src/clib/clib.timer @@ -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 diff --git a/src/clib/cprint.c b/src/clib/cprint.c new file mode 100644 index 00000000..c6ba8fd7 --- /dev/null +++ b/src/clib/cprint.c @@ -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); + } diff --git a/src/clib/crate.10 b/src/clib/crate.10 new file mode 100644 index 00000000..6467b22e --- /dev/null +++ b/src/clib/crate.10 @@ -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 diff --git a/src/clib/ctype.c b/src/clib/ctype.c new file mode 100644 index 00000000..b1458b4e --- /dev/null +++ b/src/clib/ctype.c @@ -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}; diff --git a/src/clib/date.c b/src/clib/date.c new file mode 100644 index 00000000..0b74d78a --- /dev/null +++ b/src/clib/date.c @@ -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); + } diff --git a/src/clib/fprint.c b/src/clib/fprint.c new file mode 100644 index 00000000..515c76cd --- /dev/null +++ b/src/clib/fprint.c @@ -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); + } + } diff --git a/src/clib/getsrv.c b/src/clib/getsrv.c new file mode 100644 index 00000000..48679d85 --- /dev/null +++ b/src/clib/getsrv.c @@ -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= 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 diff --git a/src/clib/its.bits b/src/clib/its.bits new file mode 100644 index 00000000..ab40b4c9 --- /dev/null +++ b/src/clib/its.bits @@ -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 */ diff --git a/src/clib/maklib.c b/src/clib/maklib.c new file mode 100644 index 00000000..2bc181d3 --- /dev/null +++ b/src/clib/maklib.c @@ -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); + } diff --git a/src/clib/maklib.stinkr b/src/clib/maklib.stinkr new file mode 100644 index 00000000..eaec674d --- /dev/null +++ b/src/clib/maklib.stinkr @@ -0,0 +1,7 @@ +x clib +l maklib +l apfnam +l c10job +l c10fnm +o ts maklib + \ No newline at end of file diff --git a/src/clib/match.c b/src/clib/match.c new file mode 100644 index 00000000..7e5ec657 --- /dev/null +++ b/src/clib/match.c @@ -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 diff --git a/src/clib/mkclib.stinkr b/src/clib/mkclib.stinkr new file mode 100644 index 00000000..85adf4ac --- /dev/null +++ b/src/clib/mkclib.stinkr @@ -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 diff --git a/src/clib/pr60th.c b/src/clib/pr60th.c new file mode 100644 index 00000000..7393b502 --- /dev/null +++ b/src/clib/pr60th.c @@ -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); + } diff --git a/src/clib/random.cmid b/src/clib/random.cmid new file mode 100644 index 00000000..928566a8 --- /dev/null +++ b/src/clib/random.cmid @@ -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 diff --git a/src/clib/stkdmp.c b/src/clib/stkdmp.c new file mode 100644 index 00000000..30f12d21 --- /dev/null +++ b/src/clib/stkdmp.c @@ -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='A' && c<='Z' ? c+('a'-'A') : c, fd); + } diff --git a/src/clib/string.cmid b/src/clib/string.cmid new file mode 100644 index 00000000..5c526c36 --- /dev/null +++ b/src/clib/string.cmid @@ -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 diff --git a/src/clib/tstfd.c b/src/clib/tstfd.c new file mode 100644 index 00000000..46fb117a --- /dev/null +++ b/src/clib/tstfd.c @@ -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 (""); + } + } diff --git a/src/clib/ttime.c b/src/clib/ttime.c new file mode 100644 index 00000000..f978580b --- /dev/null +++ b/src/clib/ttime.c @@ -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 () {;} diff --git a/src/clib/uuoh.cmid b/src/clib/uuoh.cmid new file mode 100644 index 00000000..2a4c4b7e --- /dev/null +++ b/src/clib/uuoh.cmid @@ -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