
      HED LIBRARY SUBROUTINES 
LIBSC EQU LTEMP+8   SEMI-COMPILED FLAG
LIBSP EQU LTEMP+9   START OF PROGRAM POINTER
LIBPB EQU LTEMP+13  END OF PROGRAM POINTER (PBPTR) .
ASCAH ASC 1,*-
ASC0H ASC 1,0-
M133. OCT -133
PRTMK OCT 1400
PLFBK OCT 5040
LTYP1 BSS 1 
LTYP2 BSS 1 
STABF BSS 1         USED BY STATUS
STAV1 BSS 1         USED BY 
STAV2 BSS 1           STATUS WHILE SUSPENDED
DLCHR DEF LCHAR 
DLOKP DEF DLOOK     LINK TO DIRECTORY SEARCH ROUTINE
FADTP DEF FADT      => FIND ADT 
FIDTP DEF FIDT      => FIND IDT 
GCID  DEF GCIDT     => GET CURRENT USER'S IDT 
HDBFA DEF HDBUF 
MDEDP DEF MDEAD 
MLFLA DEF MLKFL 
PCRLF DEF CRLF
RBAD  DEF RBADT     => RETURN BLOCK TO ADT
RKCYP DEF ADTAT     CYCLIC POINTER TO CURRENT 
*                                   DISK ADT TRACK ADDRESS
RTAD  DEF RTADT     => RETURN TABLE TO ADT
RTID  DEF RTIDT     => RETURN TABLE TO IDT
SCHOU DEF SCHOQ 
SCHR  DEF SCH1      => SCHEDULER
SIDTP DEF SIDT      => SEARCH IDT 
SUSPP DEF SUSP
UHDBA DEF UHDBF 
* 
MLKCT BSS 1         THESE 
MLKLB BSS 2 
MLKIN BSS 2           WORDS 
MLKLN BSS 1             ARE 
MLKRD BSS 1               USED
MLKRP DEF *+1               BY
      BSS 6                   MLOCK 
      SKP 
* 
* RDPRG READS THE CURRENT USER INTO CORE. 
* 
RDPRG NOP 
      LDA MLINK+1 
      ADA .+?PROG-?LINK 
      LDB A,I       GET PROGRAM BOUND 
      STB PBPTR 
      CMB           COMPUTE 
      ADB USE         TRANSFER
      STB MWORD         LENGTH
      CLB           BLOCK 
      STB DCLC1,I     CLOCK 
      ADA .+?DISC-?PROG  => DISC ADDRESS
      LDB USEI      READ IN 
      JSB DISCZ,I     USER
      JMP PTZAP,I   BLEW IT, ZAP THIS USER
      LDA DCLC2,I   UNBLOCK SCHEDULER.
      STA DCLC1,I 
      JMP RDPRG,I   RETURN
* 
**
***     GETID 
**
* 
* 
* GETID SCANS THE INPUT BUFFER FOR AN ID NUMBER. IF NOT FOUND, IT 
* OUTPUTS A MESSAGE AND TERMINATES. 
* IF FOUND, THE RESULT IS PLACED IN ID, -RESULT 
* IN MID. IF THE FOLLOWING CHARACTER IS A CR, GETID SKIPS ON THE
* WAY BACK. IN ANY CASE, THE NEXT CHARACTER IS IN A.
* GETID USES LTEMP+12,13,14,15. 
* 
GETCH EQU LTEMP+12
GETI1 EQU LTEMP+13
GETI2 EQU LTEMP+14
GETI3 EQU LTEMP+15
      SPC 1 
GETID NOP 
      LDA MLINK+1   DETERMINE WHICH SCANNER TO USE
      LDB DLCHR     USE LCHAR IF USER TELETYPE, 
      CPA T35LN       T35CH IF SYSTEM.
      LDB T35CH 
      STB GETCH 
      JSB GETCH,I   SCAN INPUT BUFFER FOR FIRST 
      JMP GTFER      CHARACTER. 
      ADA M133.     TEST FOR LETTER 
      SSA,RSS 
      JMP GTFER 
      ADA .+32B 
      SSA,INA 
      JMP GTFER 
      ASL 10
      STA GETI1     SAVE FOR LATER. 
      LDA .-3       SET DIGIT 
      STA GETI2      COUNTER. 
      CLB           SET NUMBER
GETI4 STB GETI3      TO 0.
      JSB GETCH,I   GET NEXT CHAR.
      JMP GTFER     FAIL. 
      ADA M72B      TEST FOR DIGIT
      SSA,RSS 
      JMP GTFER     FAIL. 
      ADA .+10
      SSA 
      JMP GTFER     FAIL. 
      LDB GETI3     GET PARTIAL VALUE.
      RBL,RBL       MULTIPLY BY 10. 
      ADB GETI3 
      RBL 
      ADB 0         ADD IN NEW DIGIT. 
      ISZ GETI2     TEST FOR DONE.
      JMP GETI4 
      ADB GETI1     MERGE IN LETTER.
      STB ID
      CMB,INB 
      STB MID 
      JSB FIDTP,I   FIND ID TRACK 
      JSB GETCH,I   GET NEXT CHARACTER. 
      ISZ GETID     SKIP RETURN IF CR.
      JMP GETID,I 
* 
**
***   SCHEDULE LIBRARY ROUTINE FOR EXECUTION
**
* 
*  THIS ROUTINE IS CALLED BY THE COMPILER WHEN IT WANTS TO EXECUTE
*  ONE OF THE FOLLOWING LIBRARY ROUTINES: CHAIN, FILES, OR ASSIGN.
*  THESE LIBRARY ROUTINES ARE ALWAYS EXECUTED WITH A PRIORITY OF 0, 
*  AS ALL LIBRARY ROUTINES ARE.  THE CALLING SEQUENCE IS: 
* 
*              JSB SCHLB,I
*              DEF <POINTER TO DISC ADDRESS OF ROUTINE> 
*              <PARAMETERS IF DESIRED>
*              <RETURN> 
* 
SCHLQ NOP 
      CLF 0 
      LDB MLINK+1 
      ADB .-?LINK 
      LDA B,I       SUSPEND 
      AND COM14       IF USER 
      SZA               TRIED TO
      JMP SUSPP,I         ABORT 
      LDA 1,I       SET UNABLE
      IOR UNABT       TO ABORT
      STA 1,I           BIT 
      ADB .+?PLEV 
      CLA 
      STA TIMEF     NO TIMING.
      STA 1,I       SET PRIORITY TO 0 
      ADB .+?STAT-?PLEV SET STATUS TO SYNTAX
      LDA %SYNT      SO SCHEDULER DOESN'T KNOW
      STA 1,I        WHAT WE'RE DOING.
      ADB .+?PROG-?STAT 
      LDA PBPTR     SET PBPTR IN TABLE. 
      STA B,I 
      CMA           COMPUTE 
      ADA USE         TRANSFER
      STA MWORD         LENGTH
      ADB .+?DISC-?PROG 
      LDA B         => SWAP AREA DISC ADDRESS 
      LDB USE       SWAP USER 
      JSB DISCZ,I     OUT OF CORE 
      JMP PTZAP,I   NO GOOD, REMOVE THIS BUM
      LDA SCHLQ,I   => LIBRARY ROUTINE DISC ADDRESS 
      ISZ SCHLQ 
      CPA LIB       IF ROUTINE IS ALREADY 
      JMP LIBRA       IN CORE, TRANSFER TO IT 
      STA LIB       SET POINTER 
      LDB M512      SET TRANSFER
      STB MWORD       LENGTH
      LDB #LIBI     READ IN 
      JSB DISCZ,I     LIBRARY ROUTINE 
      JSB SICKP,I   BAD NEWS
      JMP LIBRA 
* 
**    COMPILER CALLED ROUTINES ALWAYS RETURN HERE 
* 
SCHBL CLF 0 
      LDA HQDIS     DID THIS GUY TRY             [B]
      SZA             TO DISCONNECT?             [B]
      JMP SCHEN,I   YES                          [B]
      LDB MLINK+1 
      ADB .+?STAT-?LINK 
      ISZ 1,I       TRUE STATUS IS RUN
      ISZ TIMEF     SET FLAG FOR TIMING 
      ADB .+?CLOC-?STAT 
      ISZ 1,I       TIMED OUT?
      JMP SCHB1     NO
      ADB .+?PLEV-?CLOC 
      LDA  .+4      SET PRIORITY TO 4 
      STA B,I 
      ADB .+?RSTR-?PLEV 
      LDA SCHLQ 
      STA B,I       SET RESTART ADDRESS 
      CLA 
      STA DCLC1,I   BLOCK CLOCK 
      STF 0 
      LDB MLINK+1   REMOVE
      LDA B,I         USER FROM 
      STA MLINK+1       QUEUE 
      JSB INSEQ     INSERT AGAIN AT END 
      JMP SCHR,I    RETURN TO SCHEDULER 
SCHB1 EQU * 
      STF 0 
      JMP SCHLQ,I   RETURN TO LANGUAGE PROCESSOR
      SKP 
* 
**
***   INSERT USER INTO THE QUEUE
**
* 
* 
*  THIS SUBROUTINE INSERTS A USER INTO THE QUEUE IN ORDER OF HIS
*  PRIORITY. WHEN WE ARRIVE HERE, THE B REGISTER POINTS TO THE LINK 
*  WORD FOR THE USER.  INSEQ TRANSFORMS THE USERS ENTERING PRIORITY 
*  (EP) TO ANEW PRIORITY (NP) BY THE FOLLOWING ALGORITHM: 
*           NP = EP*NACTP/4 
*  WHERE NACTP IS THE NEGATIVE NUMBER OF ACTIVE PORTS MINUS ONE.
* 
INSEQ NOP 
      STB SCHL      SAVE LINK ADDRESS 
      ADB .+?PLEV-?LINK 
      STB SCHPR     SAVE PRIORITY ADDRESS 
      LDA B,I       COMPUTE AND 
      MPY NACTP       SAVE PRIORITY              [B]
      ARS,ARS           BASED UPON THE
      STA SCHPR,I         # OF AVAILABLE PORTS
      CMA,INA       SAVE POSITIVE 
      STA SCHPR       VALUE FOR TEST
      LDB MLINK     => PHONY USER 
INS1  STB SCHP      SAVE LINK POINTER 
      LDB B,I       B => NEXT USER
      CPB MLINK     DID WE REACH END OF QUEUE?
      JMP INS2      YES 
      LDA B         NO
      ADA .+?PLEV-?LINK 
      STA SCHT      SAVE THIS USER'S PRIORITY ADDR. 
      LDA A,I       GET THE PRIORITY AND
      ADA SCHPR       ADD THE TEST VALUE
      SSA,RSS       IF >=     TRY THE 
      JMP INS1        LINK TO NEXT USER 
      ISZ SCHT,I    INCREMENT PRIORITY
      NOP             OF PREVIOUS ENTRY 
INS2  STB SCHL,I    SET NEW ENTRY TO POINT TO USER
      LDA SCHL
      STA SCHP,I    SET PREVIOUS ENTRY => NEW ENTRY.
      ADA .+?CLOC-?LINK  SET NEW USERS CLOCK TO -10.
      LDB .-10
      STB 0,I 
      JMP INSEQ,I 
* 
**
***   ABORT CHECK 
**
* 
* 
* TEST FOR ABORT ATTEMPT WHEN THEY WEREN'T ALLOWED. IF SO, LET
* THE SCHEDULER KNOW TO ABORT HIM 
ABCHK NOP 
      CLF 0                                      [B]
      LDB MLINK+1                                [B]
      ADB .-?LINK   CLEAR                        [B]
      LDA UNABT       UNABLE                     [B]
      CMA               TO ABORT                 [B]
      AND B,I             FLAG                   [B]
      STA B,I                                    [B]
      AND ABTRY     ABORT ATTEMPTED?             [B]
      SZA                                        [B]
      JMP ABCK1     YES                          [B]
      STF 0                                      [B]
      JMP ABCHK,I   NO, RETURN                   [B]
ABCK1 EQU *                                      [B]
      IOR CHNFG     CLEAR ABORT TRY              [B]
      CMA             AND CHAIN FLAGS            [B]
      AND B,I                                    [B]
      IOR COM14     SET COMMUNICATIONS BIT       [B]
      STA B,I         TO SIGNAL SCHEDULAR        [B]
      ADB .+?STAT                                [B]
      CCA           SET STATUS                   [B]
      STA B,I         TO ABORTING                [B]
      CLA           BLOCK                        [B]
      STA DCLC1,I     CLOCK                      [B]
      STF 0 
      JMP SCHR,I    RETURN TO SCHEDULER 
* 
**
***   SEMI-COMPILE CHECK
**
* 
* 
*  CHECK IF THE PROGRAM WHICH HAS JUST BEEN LOADED FROM THE USER
*  LIBRARY IS SEMI-COMPILED, AND SET THE NECESSARY COMPILER 
*  VARIABLES.  LIBSC, LIBSP, AND LIBPB ARE PASSED TO THIS ROUTINE 
*  FROM THE LIBRARY ROUTINE WHICH CALLS IT (CHAIN, GET, OR HELLO) 
* 
SEMIC NOP 
      CLF 0 
      LDA LIBSC 
      SSA           SEMI-COMPILED?
      JMP SEMI1     YES 
      CLA           NO, CLEAR OUT-OF-            [B]
      STA OFLAG       STORAGE FLAG AND           [B]
      STA SYMTB         SYMBOL TABLE POINTER     [B]
      LDA LIBPB     SET LENGTH
      STA PBPTR       POINTER 
      LDB MLINK+1   SET 
      ADB .-?LINK     UNCOMPILED
      LDA CFLAG         BIT 
      CMA 
      AND 1,I 
      JMP SEMI3 
SEMI1 LDA LIBPB     SET 
      ADA .-7         LENGTH
      STA PBPTR         POINTER 
      STA FILTB 
      LDB 0,I       SET END-OF- 
      STB SYMTB       PROGRAM POINTER 
      INA           SET <FILES
      LDB 0,I         STATEMENT>
      STB FILCT         COUNTER 
      LDB DFILT     POINTER TO
      STB FILPT       <FILES STATEMENT>
      LDB .-4       4 <FILES
      STB SPTR        STATEMENTS> POSSIBLE
SEMI2 INA           STORE 
      LDB 0,I         POINTER 
      STB FILPT,I       TO <FILES 
      ISZ FILPT           STATEMENT>
      ISZ SPTR      ALL 4 DONE? 
      JMP SEMI2     NO
      INA           SAVE
      LDB 0,I         'USING
      STB USESN         SEEN' FLAG
      LDB MLINK+1   SET 
      ADB .-?LINK     COMPILED
      LDA 1,I           BIT 
      IOR CFLAG 
SEMI3 IOR PUALT     SET PROGRAM 
      STA B,I         UNALTERED BIT 
      STB MAIN      SET MAIN
      LDB LIBSP     SET START-OF- 
      STB SPROG       PROGRAM POINTER 
      STF 0 
      JMP SEMIC,I 
* 
* DATE COMPUTES A WORD CONTAINING THE YEAR IN ITS 7 HIGH ORDER BITS 
* AND THE DAY IN ITS 9 LOW ORDER BITS.
* 
DATE  NOP 
      LDA DATIM     GET HOUR OF YEAR. 
      CLB           DIVIDE BY 24 TO 
      DIV .+24       GET THE DAY. 
      LSL 7         POSITION ON LEFT. 
      LDB YEAR      POSITION THE YEAR 
      LSR 7 
      JMP DATE,I
* 
**  MOVE BLOCK BACKWARD 
* 
MOVEB NOP           MOVE BACKWARD -B WORDS FROM 
      SSB,INB,RSS    MOVES TO MOVED.
      JMP MOVEB,I 
      LDA MOVES,I 
      STA MOVED,I 
      CCA           UPDATE POINTERS.
      ADA MOVED 
      STA MOVED 
      CCA 
      ADA MOVES 
      STA MOVES 
      JMP MOVEB+1 
* 
**  MOVE BLOCK FORWARD
* 
MOVEW NOP           MOVES -B WORDS FROM MOVES,I TO
      SSB,INB,RSS    MOVED,I
      JMP MOVEW,I 
      LDA MOVES,I   GET A WORD
      STA MOVED,I   STORE IT. 
      ISZ MOVES     BUMP
      ISZ MOVED      POINTERS.
      JMP MOVEW+1   NO. 
      SKP 
* 
**
***   SYSTEM CONSOLE INPUT ROUTINE
**
* 
* 
* T35CQ IS USED BY LIBRARY PROGRAMS TO SCAN THE TTY35 INPUT BUFFER. 
* EACH TIME IT IS CALLED, IT FETCHES THE NEXT CHARACTER, BUT SKIPS
* BLANKS. THE CHARACTER IS LEFT IN T35LC, AND IN A. WHEN A RETURN IS
* ENCOUNTERED, T35CQ RETURNS TO P+1; OTHERWISE TO P+2. IT IS INITI- 
* ALIZED BY THE MONITOR BEFORE THE LIBRARY ROUTINE IS CALLED. 
* 
T35CQ NOP           ENTRY POINT.
      LDA T35LC     GET LAST CHARACTER. 
      CPA .+15B     IF CR,
      JMP T35CQ,I    RETURN IMMEDIATELY.
T35C0 EQU * 
      LDB T35CP     GET CHARACTER POINTER IN B+ 
      CLE,ERB        ADJUST.
      LDA 1,I       FETCH 
      SEZ,RSS        CHAR.
      ALF,ALF 
      AND B177
      STA T35LC     SAVE IT.
      ISZ T35CP     BUMP POINTER. 
      CPA .+15B     IF CR.
      JMP T35CQ,I    RETURN IMMEDIATELY.
      CPA .+40B     IF BLANK, 
T35C1 EQU * 
      JMP T35C0 
      ISZ T35CQ     OTHERWISE 
      JMP T35CQ,I    RETURN NORMAL. 
* 
**
***   SYSTEM CONSOLE OUTPUT ROUTINES
**
* 
* 
**  OUTPUT BUFFER TO SYSTEM CONSOLE AND WAIT
* 
*      A =  # OF CHARACTERS (BIT 15 = 0 FOR CRLF) 
*      B => BUFFER (BIT 15 = 1 FOR PUNCHING)
* 
T35SP NOP 
      JSB TTY35,I   FIRST OUTPUT. 
      CLF 0 
      LDA T35SP     MOVE RETURN ADDRESS 
      STA T35RS     INTO TABLE. 
      LDA T35ST     MOVE STATUS INTO PRIORITY 
      STA T35PR 
      LDA %OUTW     SET STATUS TO OUTWAIT.
      STA T35ST 
      JMP SUSPP,I   GO HANG 
* 
**  OUTPUT LF TO SYSTEM CONSOLE AND TERMINATE 
* 
LEND  LDA ONEI      OUTPUT THE
      LDB DEH        LINE FEED. 
LEND2 JSB TTY35,I   OUTPUT BUFFER AND TERMINATE 
      CLF 0 
      CLA 
      STA T35F2 
      JMP SCHEN,I 
* 
**  OUTPUT ILLEGAL FORMAT MESSAGE TO SYSTEM CONSOLE AND TERMINATE 
* 
LFRER LDA .+15
      LDB LFRDF 
      JMP LEND2 
* 
**  OUTPUT DISC ERROR MESSAGE TO SYSTEM CONSOLE AND TERMINATE 
* 
DDERR EQU * 
      LDA .+29
      LDB *+2 
      JMP LEND2 
      DEF DDERL 
* 
**
***   USER TELETYPE INPUT ROUTINE 
**
* 
* 
*  LCHAR IS USED BY LIBRARY PROGRAMS TO OBTAIN CHARACTERS FROM THE
*  USER'S INPUT BUFFER IN THE I/O PROCESSOR.  EACH TIME IT IS 
*  CALLED, IT FETCHES THE NEXT CHARACTER, SKIPS BLANKS, AND CONVERTS
*  LOWER CASE CHARACTERS TO UPPER CASE.  THE CHARACTER IS LEFT IN 
*  LCHCR AND A.  WHEN A CR IS ENCOUNTERED, LCHAR RETURNS TO P+1;
*  OTHERWISE TO P+2.
* 
LCHAR NOP 
      LDA LCHCR     GET CARRIAGE RETURN FLAG
      CPA .+15B     PREVIOUS RETURN?
      JMP LCHAR,I   YES 
LCHR1 LDB MLINK+1 
      ADB .+?TNUM-?LINK 
      LDA 1,I       FETCH 
      IOR GTC         CHARACTER 
      JSB S14SC,I       FROM 2114 
      SFS CH2       WAIT FOR
      JMP *-1         RESPONSE
      LIA CH2 
      STA LCHCR     SET CARRIAGE RETURN FLAG
      CPA .+40B     BLANK?
LCHR2 JMP LCHR1     YES, IGNORE IT
      CPA .+15B     NO, CARRIAGE RETURN 
      JMP LCHAR,I   YES--EXIT 
      ADA M96 
      SSA,RSS       LOWER CASE? 
      ADA M32       YES, CONVERT
      ADA .140      NO
      ISZ LCHAR     NO--EXIT
      JMP LCHAR,I     TO (P+2)
* 
**
***   USER TELETYPE OUTPUT ROUTINES 
**
* 
* 
** OUTPUT CHARACTER IN A TO USER'S TELETYPE 
* 
LOUT  NOP 
      LDB MLINK+1 
      ADB .-?LINK 
      JSB OUTCH,I 
      JMP LOUT,I
* 
**  OUTPUT BUFFER TO USER'S TELETYPE
*         A =  -NUMBER OF CHARACTERS
*         B => BUFFER 
* 
LTYPR NOP 
      STA LTYP1     SAVE CHARACTER COUNT
      STB LTYP2     SAVE BUFFER POINTER 
LTYP3 LDA LTYP2,I   GET FIRST 
      ALF,ALF        CHARACTER OF WORD
      JSB LOUT        OUT.
      ISZ LTYP1     ANY MORE? 
      RSS            YES
      JMP LTYPR,I   NO. 
      LDA LTYP2,I   SEND 2ND
      JSB LOUT       CHAR.
      ISZ LTYP2     BUMP POINTER. 
      ISZ LTYP1     ANY MORE? 
      JMP LTYP3     YES 
      JMP LTYPR,I 
* 
**  OUTPUT BUFFER AND CR-LF TO USER'S TELETYPE
*         A =  -NUMBER OF CHARACTERS
*         B => BUFFER 
* 
LTYPE NOP 
      JSB LTYPR 
      LDA .-2 
      LDB PCRLF     => CR-LF
      JSB LTYPR 
      JMP LTYPE,I 
* 
**  OUTPUT LF TO USER'S TTY AND TERMINATE 
* 
LLEND LDA .+12B 
      JSB LOUT
      JMP SCHEN,I 
      SPC 2 
* 
**  ERROR MESSAGE TERMINAL CHECK
* 
GTFER LDA GETCH     IF SYSTEM TELETYPE, PRINT 
      CPA T35CH     ERROR MESSAGE THERE.
      JMP LFRER 
* 
**  OUTPUT ILLEGAL FORMAT MESSAGE TO USER'S TTY AND TERMINATE 
* 
ILFER LDA .-15      OTHERWISE PRINT IT ON 
      LDB LFRDF     USER TELETYPE.
* 
**  OUTPUT BUFFER AND CR-LF TO USER'S TTY AND TERMINATE 
* 
LIBER JSB LTYPE 
      JMP SCHEN,I   TERMINATE.
* 
**
***   BUFFERS AND MESSAGES
**
* 
      SUP 
T35BF BSS 36        BUFFER FOR INPUT AND REPLIES. 
CRLF  OCT 6412      MUST FOLLOW T35BF 
      SPC 2 
HELK  DEF *+1 
      OCT 5111
      ASC 7,LLEGAL ACCESS 
      SPC 2 
HELH  DEF *+1 
      OCT 5116
      ASC 6,O TIME LEFT 
     SPC 2
LFRDF DEF *+1 
      OCT 5111
      ASC 7,LLEGAL FORMAT 
      UNS 
      SPC 2 
      BSS 0 
