
* 
**                                  **
**  EXECUTE <PRINT USING STATEMENT>  ** 
**                                  **
* 
*  EXIT TO (P+1) IF NO USING OPERATOR FOUND, OTHERWISE PREPARE
*  FORMAT SPECIFICATION STRING AND CALL FORMATTED OUTPUT ROUTINE. 
* 
#EPRU STA FFLG      SAVE FORMAT FLAG
      LDB TEMP1 
      LDA B,I 
      CPA PRTOP     NULL OPERAND? 
      INB,RSS       YES 
      JMP EPRUS,I   NO, CAN'T BE USING STATEMENT
      CPB PRGCT     END OF STATEMENT? 
      JMP EPRUS,I   YES 
      LDA B,I       NO, 'USING' 
      AND OPMSK       OPERATOR
      CPA USEOP         NEXT? 
      RSS           YES 
      JMP EPRUS,I   NO, EXIT
      XOR B,I       GET OPERAND 
      STB TEMP1     SAVE POINTER
      SSA,RSS       INTEGER FOLLOWS?
      JMP EPRU1     NO
      INB 
      LDB B,I       GET ADDRESS OF IMAGE STATEMENT
      ADB .+2       => LENGTH WORD
      LDA B,I 
      AND OPMSK     GET OPERATOR
      CPA IMGOP     IMAGE?
      RSS           YES 
      JSB RERRS+38,I  NO, ERROR 
      ISZ TEMP1     BUMP TO POINT 
      ISZ TEMP1       TO FIRST OPERAND
      CLA 
      STA NCH 
      JSB FRMAT     CALL FORMATTER
EPRU1 SZA,RSS       NULL OPERAND? 
      JMP EPRU4     YES 
      JSB FORMX     NO, FETCH 
      LDA .-2         STRING
      JSB PSTR          OPERAND 
      LDA TEMP6,I   GET 
      AND B377        LENGTH
      SZA,RSS       NULL STRING?
      JMP XEC1      YES 
      CMA,INA       NO, SAVE
      STA STRLN       -LENGTH 
      LDB TMPST 
      ADB .+2 
      LDA B,I       GET FIRST SUBSCRIPT 
      CMA,INA       NEGATE IT 
      INB 
      ISZ B,I       SECOND SUBSCRIPT EXIST? 
      JMP EPRU2     YES 
      CLA           NO, SET 
      STA NCH         CHARACTER COUNT 
      JMP EPRU3 
EPRU2 ADA B,I       COMPUTE DIFFERENCE
      SZA,RSS       NULL STRING?
      JMP XEC1      YES 
      SSA           NO, NEGATIVE? 
      JSB RERRS+44,I YES
      STA NCH       NO, SAVE DIFFERENCE 
      CCA 
      ADA B,I       SECOND
      ADA STRLN       SUBSCRIPT 
      SSA,RSS           VALID?
      JSB RERRS+44,I NO 
EPRU3 ADB .-1       YES 
      LDA B,I       FIRST 
      ADA STRLN       SUBSCRIPT 
      SSA,RSS           VALID?
      JSB RERRS+44,I NO 
      LDA B,I       YES, LOAD IT
      LDB TEMP6     => FIRST WORD OF STRING 
      JSB FRMAT     CALL FORMATTER
EPRU4 INB           => 1ST WORD OF STRING 
      LDA B,I       UPDATE
      AND OPDMK 
      INA             INTRA-
      ARS 
      ADA TEMP1         STATEMENT 
      ADA .+2 
      STA TEMP1           POINTER 
      CLA 
      STA NCH 
      JSB FRMAT     CALL FORMATTER
* 
***                             **
**  EXECUTE <RESTORE STATEMENT>  ** 
***                             **
* 
ERSTR LDA TEMP1,I   LOAD FLAG WORD
      ISZ TEMP1     ADVANCE STATEMENT POINTER 
      LDB SPROG     SET (B) TO START OF PROGRAM 
      SSA           'LABELLED RESTORE'
      LDB TEMP1,I   YES, RESET (B) TO STATEMENT 
      JSB SETDP     SET DATA POINTERS 
      JMP XEC1
* 
***                            ** 
**  EXECUTE <ENTER STATEMENT>   **
***                            ***
* 
EENTR LDA TEMP1,I   => FIRST OPERATOR 
      AND OPDMK 
      SZA           IS '#' PRESENT? 
      JMP EENT3     NO
      LDB TEMP1 
      INB 
      LDA B,I       GET NEXT OPERATOR 
      AND OPMSK 
      CPA B4000     '#'?
      RSS           YES 
      JMP EENT3     NO
      STB TEMP1 
      JSB FORMX     EVALUATE ADDRESS
      LDB OPDST,I 
      STB SBPTR     => SYMBOL 
      LDA OPDST     UNSTACK 
      ADA .-2 
      STA OPDST       ADDRESS 
      LDB MAIN
      INB           => USERS TTY # IN TELETYPE TABLE
      LDA 1,I       GET TTY # AND 
      ALF,ALF         RIGHT JUSTIFY 
      FLT                                        [B]
      STA SBPTR,I   STORE 
      ISZ SBPTR       TTY 
      STB SBPTR,I       NUMBER
      LDA TEMP1     ENTER STATEMENT 
      CPA PRGCT       FINISHED? 
      JMP XEC1      YES 
EENT3 JSB FETCH     NO--FETCH ALLOWED TIME
      JSB IFIX      CONVERT 
      NOP             TO
      LDA 1             SECONDS 
      AND B377      MASK TO 8 BITS
      SZA,RSS       IF 0, SET 
      INA             TO 1
      STA ATIM
      LDA MAIN      DOES THIS USER
      INA             HAVE THE
      CPA PRIST         LINE PRINTER? 
      JSB WERRS+9,I YES - RELEASE IT
      LDA .+21B     OUTPUT
      JSB OUTCR       AN X-ON 
      LDA STE       START 
      IOR ATIM        ENTER 
      JSB SCHIN,I       TIMING
ENTRT EQU * 
      JMP EENT6     INPUT ENTERED 
      JSB FORMX     TIMEOUT OCCURED 
      LDB OPDST,I   => RESPONSE 
      STB SBPTR       TIME
      LDA OPDST     UNSTACK 
      ADA .-2 
      STA OPDST       ADDRESS 
      LDA M256      SET 
      FLT             RESPONSE                   [B]
      STA SBPTR,I       TIME
      ISZ SBPTR           TO
      STB SBPTR,I           -256
      JMP *+1,I 
      DEF EEN18 
EENT6 EQU * 
      CLB           DON'T SUPPRESS
      STB BLANK       BLANKS
      JSB GETCR     FIRST 
      NOP             CHARACTER A 
      LDB .+40B     SUPPRESS
      STB BLANK       BLANKS
      CPA .+3           CONTROL C?
      JMP EXITA,I   YES 
      JSB BCKSP     NO
      JSB FORMX     EVALUATE ADDRESS
      LDB OPDST,I 
      STB SBPTR     => RESPONSE TIME
      STB RSPTR 
      LDA OPDST     UNSTACK 
      ADA .-2 
      STA OPDST       ADDRESS 
      LDB MAIN
      ADB .+?RTIM   GET RESPONSE
      LDA 1,I         TIME
      FLT                                        [B]
      STA SBPTR,I   STORE 
      ISZ SBPTR       IT
      STB SBPTR,I 
      JSB FORMX     EVALUATE ADDRESS
      LDB OPDST,I   IS IT A 
      SSB             STRING VARIABLE?
      JMP EEN10     YES 
      LDA OPDST     NO, 
      ADA .-2         UNSTACK 
      STA OPDST         ADDRESS 
      STB SBPTR     SAVE DESTINATION ADDRESS
      CLA           SET SIGN
      STA SIGN        TO POSITIVE 
      JSB GETCR     FETCH FIRST CHARACTER 
      JMP EEN17     NONE FOUND--ERROR 
      CCB           TURN OFF
      STB ENOUF       OVER/UNDERFLOW FLAG 
      CPA .+55B     '-'?
      JMP EENT7     YES 
      CLB,INB       NO
      CPA .+53B     '+'?
      RSS           YES 
      JMP EENT8     NO
EENT7 STB SIGN      SET SIGN
      JSB GETCR     GET NEXT CHARACTER
      JMP EEN17     NONE FOUND
EENT8 JSB NUMCK     NUMBER? 
      NOP           NO--ERROR 
      JMP EEN17     BAD EXPONENT--ERROR 
      ISZ ENOUF     DID OVER/UNDERFLOW OCCUR? 
      JMP EEN17     YES--ERROR
      CPA .+15B     NO, CARRIAGE RETURN FOLLOWS?
      JMP EEN18     YES 
      JMP EEN17     NO--ERROR 
EEN10 CMB           EXTRACT 
      LDA 1,I         PHYSICAL
      ALF,ALF           LENGTH OF 
      AND B377            DESTINATION STRING
      CMA           SET IT AS END 
      ADA TMPST,I     OF UNSPECIFIED
      STA TPRME         DESTINATION STRING
      CCA           PREPARE 
      JSB PSTR        DESTINATION STRING
      LDB TNULL     SAVE LENGTH 
      STB INTMP       ALLOWANCE 
      CLB           TURN OFF
      STB BLANK       BLANK SUPPRESSION 
      LDA FENCA     POINT TO ENTER CHAR ROUTINE 
      JSB TRSTR     TRANSFER STRING 
      CLB           ALL REQUESTED 
      CPB TNULL       CHARACTERS TRANSFERRED? 
      JMP EEN14     YES 
      CPB PS1       NO, TRANSFER LENGTH SPECIFIED?
      JMP EEN13     NO
      STA INTMP     YES--SAVE (A) 
      CCA           FINISH
      STA TPRME 
      ADA TNULL       TRANSFER
      STA TNULL 
      LDA FSCHA         WITH BLANKS 
      JSB TRSTR 
      JMP EEN18 
EEN13 LDB TEMP6,I   SET LOGICAL 
      ADB TNULL       TO ACTUAL 
      STB TEMP6,I       STRING LENGTH 
      JMP EEN18 
EEN14 CPB PS1       LENGTH OF TRANSFER SPECIFIED? 
      JMP EEN16     NO
EEN15 JSB GETCR     YES 
      JMP EEN18     CARRIAGE RETURN 
      JMP EEN15     LOOK FOR CARRIAGE RETURN
EEN16 JSB GETCR     END-OF-INPUT NEXT?
      JMP EEN18     YES 
      LDA INTMP     NO--DESTINATION STRING EXCEEDED 
      STA TNULL     RESTORE 
      LDA SBPTR       DESTINATION STRING
      STA TEMP5         PARAMETERS
EEN17 LDA RSPTR,I   TAKE
      ISZ RSPTR     ARITHMETIC
      LDB RSPTR,I       INVERSE OF
      JSB ARINV           RESPONSE TIME 
      STB RSPTR,I   STORE 
      CCB             IN
      ADB RSPTR         VALUE 
      STA 1,I             TABLE 
      STB ENOUF     CLEAR OVER/UNDERFLOW FLAG 
EEN18 CLA           ZERO CHARACTER
      STA CHRCT       COUNTER 
      LDA .+40B     RESTORE 
      STA BLANK       BLANK SUPPRESSION 
      CLA           OUTPUT A
      JSB OUTCR     NULL. 
      JMP XEC1
* 
***                            ** 
**  EXECUTE <ASSIGN STATEMENT>  **
***                            ** 
* 
EASN  EQU * 
      LDA .-3 
      STA LT5 
      STA ASINP     SET FLAG TO SAY ASSIGN OCCURRED 
      LDB ASBFA 
      LDA DBLNK 
EASN0 EQU * 
      STA B,I       BLANK OUT 3 WORDS 
      INB 
      ISZ LT5 
      JMP EASN0 
      CLA,INA       ALLOW STRING
      STA EOL         CONSTANT
      JSB FORMX     EVALUATE STRING 
      LDA .-2 
      JSB PSTR      PREPARE STRING OPERAND
      STA TEMP4     SAVE SORCE POINTER
      CLA           INITIALIZE TO 
      STA ASTYP       LOCAL LIBRARY 
      CPB .-1       NULL STRING?
      JMP EAS02     YES 
      STB TPRME     SAVE STRING LENGTH
      LDB TEMP4     GET FIRST 
      CLE,ERB 
      LDA B,I         CHARACTER 
      SEZ,RSS 
      ALF,ALF           OF STRING 
      AND B377
      CLB,INB       SET FOR PUBLIC LIBRARY
      CPA .+44B     '$'?
      JMP EAS01     YES 
      CPA .+52B     NO, '*'?
      INB,RSS       YES, SET FOR GROUP LIBRARY
      JMP EAS00     NO
EAS01 EQU * 
      STB ASTYP     SAVE LIBRARY TYPE 
      ISZ TEMP4     BUMP SOURCE POINTER 
      ISZ TPRME     BUMP LENGTH 
EAS00 EQU * 
      LDA TPRME 
      ADA .+7 
      SSA           LENGTH > 6? 
      CLA           YES, SET TO 6 
      ADA .-7       NO
      STA TPRME 
      STA TNULL 
      LDA ASBFA     POINTER TO
      STA ASBFP       NAME BUFFER 
      ALS 
      STA TEMP5     DESTINATION STRING POINTER
      LDA FCUCA     UPPER CASE CHARACTERS ONLY
      JSB TRSTR     MOVE NAME 
EAS02 JSB FETCH     EVALUATE NUMERIC OPERAND
      JSB SBFIX     ROUND TO INTEGER
      LDB B1000 
      STB ORDNO     SAVE SPECIFIED ORDINAL NUMBER 
      JSB FORMX     LEAVE NEXT VARIABLE ON TOP OF STACK 
      LDA OPDST,I   SAVE ADDRESS OF USER VARIABLE 
      STA ATMP+1
      LDA .+4       SET DEFAULT                  [B]
      FLT             RETURN CODE TO              [B
      DST ATMP+1,I      NON-EXISTANT FILE        [B]
      JSB OPCHK          UNSTACK VALUE ADDRESS
      LDA ORDNO     DOES
      CMA             REQUESTED 
      ADA FCNTR         FILE
      CMA,SSA,RSS         EXIST?
      JMP XEC1      NO, DONE
      CLB 
      LDA ORDNO     LOCATE
      MPY .+FTEL       CORRECT
      ADA FILTB         FCB 
      ADA .+5 
      STA FBASE       DISC ADDRESS AND SAVE IT
      ADA .+3 
      LDB 0,I       GET CURRENT BUFFER ADDRESS
      ADA .-7 
      LDA 0,I 
      ALR,RAR       CLEAR BITS 15 AND 14
      CMA,INA 
      ADA 1 
      STA RQ3 
      JSB WRBUF     WRITE OUT RECORD
      LDA FBASE     RESTORE 
      ADA .-5         FCB 
      STA FBASE           POINTER 
      CLB 
      STB 0,I       INITIALIZE
      ADA .+14
      STB 0,I       INITIALIZE PROTECTMASK TO 0 
      STB RETCD     INITIALIZE RETURN CODE
      JSB SCHLB,I   CALL IN 
      DEF ASNIB       ASSIGN OVERLAY
      JMP EASN4     FILE RECORD SIZE TOO LARGE
      ISZ RETCD     FILE DOESN'T EXIST OR PROTECTED 
      ISZ RETCD     'READ ONLY' - GROUP OR A000 
      ISZ RETCD     'READ ONLY' - FILE IN USE 
      LDA TEMP1 
      CPA PRGCT          END OF STATEMENT ? 
      JMP EASN3          YES
      LDA 0,I            TEST FOR A COMMA 
      AND OPMSK 
      CPA B2000     COMMA FOLLOWING?
      RSS 
      JMP EASN3     NO
      CLA,INA       ALLOW 
      STA EOL       STRING CONSTANT 
      JSB FORMX     YES, EVALUATE STRING OPERAND
      LDA .-2       PREPARE 
      JSB PSTR        SOURCE
      STA TEMP4         STRING
      STB TPRME 
      LDA ASBFA 
      STA ASBFP     GET CHARACTER 
      ALS             POINTER TO
      STA TEMP5         PASSWORD BUFFER 
      LDA .-3 
      STA LT5 
      LDB ASBFP 
      LDA DBLNK 
      STA 1,I       FILL PASSWORD 
      INB             BUFFER WITH 
      ISZ LT5           BLANKS
      JMP *-3 
      LDA .-7       SET LENGTH (IN CHARACTERS)
      STA TNULL       OF PASSWORD BUFFER
      LDA FSCHA 
      JSB TRSTR     MOVE PASSWORD TO BUFFER 
      LDA ASBFP 
      INA 
      DLD 0,I 
      ADA ASBFP,I   ADD WORD1 AND WORD2 
      XOR 1         EXCLUSIVE OR - WORD3
      IOR RBP       INCLUSIVE OR BITS 14 AND 15 
      LDB FBASE 
      ADB .+14
      STA 1,I       STORE PROTECTMASK IN FCB
* 
EASN3 LDA RETCD     A = RETURN CODE 
      RSS 
EASN4 LDA .+5 
      FLT           FLOAT RETURN CODE AND        [B]
      DST ATMP+1,I    STORE IN USER VARIABLE
      JMP XEC1      DONE
      SKP 
* 
***                    ** 
**  COMPLETE EXECUTION  **
***                    ** 
* 
EXIT  EQU * 
      CLF 0 
      LDA MAIN,I    INHIBIT 
      IOR UNABT 
      STA MAIN,I      ABORTS
      STF 0 
      LDA FCNTR     SET COUNTER TO
      CMA             1'S COMPLEMENT OF 
      STA FCNTR         NUMBER OF FILES 
      INA           SAVE 2'S COMPLEMENT FOR 
      STA FRMAT       LCD'S FILE COUNT
      LDA FCORE     LOAD FIRST BUFFER ADDRESS 
      LDB FILTB     LOAD POINTER TO 
      ADB .+5         FIRST DISC ADDRESS (LOW WORD) 
EXIT0 ISZ FCNTR     MORE FILES? 
      JMP EXIT2     YES 
      JSB LCDLP     UPDATE LAST CHANGE DATE 
EXIT3 JSB ABCK,I    CHECK FOR ABORTS
      LDA EXIT1 
      STA LT1         COMPLETION
      LDA MAIN,I
      AND HFLAG 
      SZA               MESSAGE UNLESS
      CCA,RSS             $HELLO PROGRAM
      LDA .-4 
      LDB MAIN      DOES USER 
      INB             HAVE LP?
      CPB PRIST 
      RSS 
      JMP EXIT4     NO. 
      LDA EXT1A     YES.
      STA LT1       RELEASE IT AND
      LDA .-10        PRINT MESSAGE 
      CLB 
      STB PRIST 
EXIT4 CLB 
      STB LT2 
      JSB OUTST 
      LDA MAIN      TELL 2114 
      INA 
      LDA 0,I         THAT USER IS
      IOR UNR 
      JSB S14LP,I       FINISHED RUNNING
      LDA .+4       CLEAR PBFLG AND CBFLG 
      LDB MAIN
      JSB EDABR         BITS. 
      JMP SCHEN,I 
EXT1A DEF * 
      OCT 11423 
      OCT 6412
      ASC 3,LP FRE
EXT1  EQU * 
      OCT 42412 
      OCT 6412
      ASC 2,DONE
      OCT 6412
EXIT2 STB FBASE     WRITE 
      STA RQ3         OUT 
      JSB WRBUF         RECORD
      LDB FBASE     GET RECORD
      ADB .+FTEL-4   SIZE OF NEXT FILE
      LDA 1,I 
      ALR,RAR       CLEAR BITS 14 AND 15
      CMA,INA 
      ADB .+7        GET END OF FILE BUFFER 
      ADA 1,I       COMPUTE FILE BUFFER STARTING ADDRESS
      ADB .-3        POINT B TO FIRST DISC ADDRESS
      JMP EXIT0 
      SPC 2 
DBLNK OCT 20040 
ASBFA DEF ERSEC+60
XECBR DEF XECTB-42B,I 
FENCA DEF FENCH 
FINCA DEF FINCH 
MIOEN DEF MIO7
M74   DEC -74 
EXIT1 DEF EXT1
