Trailing-Edge
-
PDP-10 Archives
-
BB-H311D-RM
-
swskit-tools/zsubs.mac
There are 3 other files named zsubs.mac in the archive. Click here to see a list.
IFNDEF REL,<REL==0> ;BUILD UNIVERSAL BY DEFAULT
IFE REL,< UNIVERSAL ZSUBS SUBROUTINE/LUUO PACKAGE>
IFN REL,<
TITLE ZSUBS SUBROUTINE/LUUO PACKAGE
>
SUBTTL J. G. ZIMA/JGZ MARCH 1981
SEARCH MACSYM,MONSYM,JOBDAT ;GET SYMBOLS
SALL ;NICE LOOKING MACROS
.DIRECT FLBLST ;AND NICE LISTING
;VERSION INFORMATION:
VMAJOR==1 ;MAJOR VERSION LEVEL
VMINOR==0 ;MINOR VERSION LEVEL
VEDIT==^D10 ;EDIT LEVEL
VWHO==0 ;WHO LAST EDITED
;ZSUBS IS A PRODUCT OF THE TOPS-20 MONITOR SUPPORT GROUP OF SOFTWARE SERVICES,
;PRIMARILY FOR USE WITH PROGRAMS TO BE INCLUDED ON THE TOPS-20 MONITOR SWSKIT.
;ITS PURPOSE IS TO PROVIDE A "STANDARD" SET OF SUBROUTINE FUNCTIONS VIA THE
;LUUO MECHANISM, CONSISTING OF I/O, COMND, AND PSI BASIC LEVEL CODE USED IN
;MANY OF THE SWSKIT PROGRAMS. IT IS SEPARATED TO ALLOW UPDATING OF ONLY A
;SINGLE COPY OF THE CODE.
;
;RELATED FILES:
; ZSUBS.REL THE SUPPORT CODE REL FILE
; ZSUBS.UNV THE UNIVERSAL GENERATED
; ZSUBS.MAC THIS FILE
; ZSUBS.CTL CONTROL FILE TO BUILD ZSUBS
SUBTTL TABLE OF CONTENTS
; TABLE OF CONTENTS PAGE
; ----------------- ----
;
; 1. J. G. ZIMA/JGZ MARCH 1981 . . . . . . . . . . . . . . . . . 1
; 2. TABLE OF CONTENTS. . . . . . . . . . . . . . . . . . . . . . 2
; 3. REVISION HISTORY . . . . . . . . . . . . . . . . . . . . . . 3
; 4. DEFINITIONS. . . . . . . . . . . . . . . . . . . . . . . . . 4
; 5. INITIALIZATION ROUTINE . . . . . . . . . . . . . . . . . . . 8
; 6. THE SIMPLE COMMANDS - EXIT . . . . . . . . . . . . . . . . . 9
; 7. PUSH COMMAND . . . . . . . . . . . . . . . . . . . . . . . . 10
; 8. TAKE COMMAND . . . . . . . . . . . . . . . . . . . . . . . . 11
; 9. LUUO HANDLER AND PROCESSING ROUTINES . . . . . . . . . . . . 13
; 10. ERROR AND NORMAL TEXT OUTPUT UUOS. . . . . . . . . . . . . . 14
; 11. NUMERIC OUTPUT UUOS. . . . . . . . . . . . . . . . . . . . . 15
; 12. FILESPEC OUTPUT UUO. . . . . . . . . . . . . . . . . . . . . 16
; 13. VERSION NUMBER OUTPUT UUO. . . . . . . . . . . . . . . . . . 17
; 14. PSI ROUTINE UUOS AND SUPPORT CODE. . . . . . . . . . . . . . 18
; 15. COMND JSYS LUUO ROUTINES . . . . . . . . . . . . . . . . . . 19
; 16. ERROR PROCESSING ROUTINES. . . . . . . . . . . . . . . . . . 20
; 17. THE DATA AREA. . . . . . . . . . . . . . . . . . . . . . . . 21
SUBTTL REVISION HISTORY
;REVISION HISTORY:
;
; 1 JGZ 23-MAR-81
; START KEEPING THE REVISION HISTORY NOW THAT IT SORT OF WORKS.
;
; 2 JGZ 7-JAN-82
; MOVE CLOSE OF OJFN LATER IN LOSE TO AVOID POSSIBLY CLOBBERING
; THE ERROR WE WERE REALLY INTERESTED IN.
;
; 3 JGZ 15-JAN-82
; USE THE STDAC. MACRO FROM MACSYM TO GET THE STANDARD AC DEFS.
;
; 4 JGZ 24-JAN-82
; ADD LERROR UUO/MACRO TO DO SAME AS ERROR, BUT ALSO DO LOSE
; PROCESSING FOR LAST PROCESS ERROR.
;
; 5 JGZ 28-JAN-82
; ADD PRTJFN, TYPJFN UUO/MACRO TO DO JFNS FILESPEC OUTPUT OF A
; GIVEN JFN.
;
; 6 JGZ 10-FEB-82
; PUT IN THE MORE COMPLICATED FORM OF THE AA MACRO TO ALLOW
; FLAG BITS LIKE CM%INV,...
;
; 7 JGZ 13-MAY-83
; SET PC%USR IN ABTADR SO CAN ABORT OUT OF JSYSES ALSO
; EVERY TIME...
;
; 8 JGZ 9-APR-84
; HANDLE VI%DEC SET IN VERSION NUMBER UUO.
;
; 9 JGZ 23-JUL-84
; CHANGE DOFORK CALLING SEQUENCE - RET ON FILE ERRORS,
; LOSE ON FORK ERRORS, RETSKP ON SUCCESS.
;
; 10 JGZ 23-JUL-84
; USE DEFAULT-EXEC: IN PUSH COMMAND FOR RELEASE 6 (IN A
; BACKWARDS COMPATIBLE MANNER).
;
SUBTTL DEFINITIONS
;ACCUMULATORS:
STDAC. ;STANDARD MACSYM ACS
;LUUO DEFINITIONS:
DEFSTR UUONUM,.JBUUO,8,9 ;LUUO OPCODE FIELD
DEFSTR UUOAC,.JBUUO,12,4 ;LUUO AC FIELD
OPDEF PRINT. [1B8] ;PRINT LUUO
OPDEF TYPE. [2B8] ;TYPE LUUO
OPDEF WARN. [3B8] ;WARN LUUO
OPDEF ERROR. [4B8] ;ERROR LUUO
OPDEF OCTOU. [5B8] ;OCTAL OUTPUT LUUO
OPDEF DECOU. [6B8] ;DECIMAL OUTPUT LUUO
OPDEF TOCT. [7B8] ;OCTAL OUTPUT LUUO FOR .PRIOU
OPDEF TDEC. [10B8] ;DECIMAL OUTPUT LUUO FOR .PRIOU
OPDEF TSPACE [11B8] ;TYPE SPACES LUUO
OPDEF PSPACE [12B8] ;PRINT SPACES LUUO
OPDEF PARSE [13B8] ;PARSE COMND FIELD LUUO
OPDEF NOISE. [14B8] ;GUIDEWORD COMND LUUO
OPDEF CONFRM [15B8] ;CONFIRM COMND LUUO
OPDEF VERSIO [16B8] ;VERSION NUMBER OUTPUT LUUO
OPDEF SETABT [17B8] ;SET CONTROL-E ABORT ROUTINE ADDRESS
OPDEF CLRABT [20B8] ;CLEAR CONTROL-E ABORT LUUO
OPDEF LERRO. [21B8] ;ERROR + LAST ERROR LUUO
OPDEF PRTJF. [22B8] ;PRINT JFNS INFO LUUO
OPDEF TYPJF. [23B8] ;TYPE JFNS INFO LUUO
;MACROS USED TO CALL LUUOS:
DEFINE PRINT(STRING),<PRINT. [ASCIZ\STRING\]> ;;MACRO FOR PRINT LUUO
DEFINE TYPE(STRING),<TYPE. [ASCIZ\STRING\]> ;;MACRO FOR TYPE LUUO
DEFINE WARN(STRING),<WARN. [ASCIZ\STRING\]> ;;MACRO FOR WARN LUUO
DEFINE ERROR(STRING),<ERROR. [ASCIZ\STRING\]> ;;MACRO FOR ERROR LUUO
DEFINE LERROR(STRING),<LERRO. [ASCIZ\STRING\]> ;;MACRO FOR LERROR LUUO
DEFINE OCTOUT(VALUE,SIZE),< ;;MACRO FOR CALLING OCTOUT LUUO
IFB <SIZE>,< OCTOU. 0,VALUE>
IFNB <SIZE>,< OCTOU. SIZE,VALUE>
>
DEFINE DECOUT(VALUE,SIZE),< ;;MACRO FOR CALLING DECOUT LUUO
IFB <SIZE>,< DECOU. 0,VALUE>
IFNB <SIZE>,< DECOU. SIZE,VALUE>
>
DEFINE TOCT(VALUE,SIZE),< ;;MACRO FOR CALLING TOCT LUUO
IFB <SIZE>,< TOCT. 0,VALUE>
IFNB <SIZE>,< TOCT. SIZE,VALUE>
>
DEFINE TDEC(VALUE,SIZE),< ;;MACRO FOR CALLING TDEC LUUO
IFB <SIZE>,< TDEC. 0,VALUE>
IFNB <SIZE>,< TDEC. SIZE,VALUE>
>
DEFINE PRTJFN(VALUE,MODE),< ;;MACRO FOR CALLING PRTJFN LUUO
IFB <MODE>,< PRTJF. 0,VALUE>
IFNB <MODE>,< PRTJF. 1,VALUE>
>
DEFINE TYPJFN(VALUE,MODE),< ;;MACRO FOR CALLING TYPJFN LUUO
IFB <MODE>,< TYPJF. 0,VALUE>
IFNB <MODE>,< TYPJF. 1,VALUE>
>
DEFINE NOISE(STRING),<NOISE. [ASCIZ\STRING\]> ;;MACRO FOR NOISE. UUO
DEFINE AA(NAME,DATA,BITS),< ;;MACRO FOR COMMAND TABLES
IFB <BITS>,<
XWD [ASCIZ/NAME/],DATA
>
IFNB <BITS>,<
XWD [EXP CM%FW!<BITS>
ASCIZ/NAME/],DATA
>
>
DEFINE TEXT(STRING),< ;;MACRO FOR ASCIZ TEXT, I.E. HELP TEXTS
XLIST
ASCIZ\STRING\
LIST
>
;MACRO TO CALL INITIALIZATION ROUTINE:
DEFINE $INIT,< ;;MACRO FOR INITIALIZATION
.REQUIRE ZSUBS ;;REQUIRE THE REL FILE
EXTERN $INIT. ;;INITIALIZATION ROUTINE
EXTERN CMDBLK,JFNBLK,TXTBUF,ATMBUF ;;COMND VARIABLES
EXTERN .EXIT,.PUSH,.TAKE ;;USABLE COMMAND ROUTINES
EXTERN LEVTAB,CHNTAB,SAVPSI ;;PSI SYSTEM VARIABLES
EXTERN LOSE ;;ERROR ROUTINE
EXTERN OJFN ;;OUTPUT JFN
EXTERN JFNTMP ;;ONE WORD "JFN STACK"
EXTERN PDL ;;STACK
EXTERN DOFORK ;;FORK RUNNER
EXTERN COMMND ;;MORE PRIMITIVE COMND ENTRY
JSP CX,$INIT. ;;CALL THE INITIALIZATION ROUTINE
>
;DEFAULT PARAMETERS:
TXTLEN==:^D80*^D6 ;SIZE OF COMMAND BUFFERS
PDLSIZ==:100 ;SIZE OF PUSHDOWN STACK
;CONSTANTS:
INTCHN==:0 ;CHANNEL FOR ^E INTERRUPT
SUBTTL INITIALIZATION ROUTINE
IFN REL,<
;INITIALIZATION ROUTINE:
$INIT.::MOVE P,[IOWD PDLSIZ,PDL] ;SETUP A STACK
MOVE T1,[CALL LUUOH] ;SETUP THE
MOVEM T1,.JB41 ; LUUO LOCATION
SETZM TAKJFN ;CLEAR TAKE FILE JFN/STATE
SETZM OJFN ;CLEAR OUTPUT JFN
MOVX T1,.FHSLF ;SETUP THE
MOVE T2,[LEVTAB,,CHNTAB] ; INTERRUPT SYSTEM
SIR
MOVX T1,.FHSLF ;AND ACTIVATE
MOVX T2,1B<INTCHN> ;THE CHANNEL TO USE FOR ^E INTERRUPTS
AIC ;SET THEM UP
MOVX T1,.FHSLF ;AND FINALLY
EIR ; TURN PSI'S ON, WITH NOTHING ON THE CHANNEL
JRST 0(CX) ;RETURN TO THE CALLER
;THE GENERIC SKIP AND NONSKIP RETURN INSTRUCTIONS
RSKP:: AOS 0(P) ;YE OLDE SKIP
R:: RET ; AND NONSKIP RETURNS
SUBTTL THE SIMPLE COMMANDS - EXIT
;EXIT FROM PROGRAM. "EXIT" COMMAND.
.EXIT:: NOISE (FROM PROGRAM) ;DO GUIDEWORDS
CONFRM ;THEN CONFIRM THE COMMAND
SKIPE T1,OJFN ;CHECK AND
CLOSF ; CLOSE ANY OUTPUT
ERJMP .+1 ; IGNORE
SETZM OJFN ;MARK CLOSED
HALTF ;QUIT FOR THE NONCE
RET ;AND RETURN TO DO ANOTHER COMMAND
; IF CONTINUED
SUBTTL PUSH COMMAND
;PUSH COMMAND TO PUSH TO A NEW EXEC IN AN INFERIOR FORK
.PUSH:: NOISE (COMMAND LEVEL) ;DO GUIDEWORDS
CONFRM ;CONFIRM THE COMMAND
HRROI T2,[ASCIZ/DEFAULT-EXEC:/] ;THE V6 FORM...
CALL DOFORK ;TRY TO PUSH
SKIPA ; FAILED - TRY OTHER ALTERNATIVE
RET ;DONE
HRROI T2,[ASCIZ/SYSTEM:EXEC.EXE/] ;FILENAME FOR EXEC
CALL DOFORK ;TRY OLD WAY
JRST LOSE ; FAILED TOO...
RET ;DONE OK
;COMMON CODE FOR HANDLING AN INFERIOR. GET THE FILE, START IT UP
;IN AN INFERIOR FORK, AND WAIT FOR IT TO FINISH, THEN RETURN.
;RETURNS +1 ON FILE ERRORS, TO LOSE ON FORK ERRORS, +2 ON SUCCESS
DOFORK::MOVX T1,GJ%PHY!GJ%OLD!GJ%SHT ;GTJFN BITS
GTJFN ;GET A HANDLE ON THE FILE
ERJMP R ;UNAVAILABLE???
MOVEM T1,JFNX ;SAVE JFN TO IT
MOVX T1,CR%CAP ;PRESERVE OUR CAPABILITIES
CFORK ;BUILD A FORK
ERJMP LOSE ;COULDN'T
MOVEM T1,HANDLE ;SAVE FORK HANDLE
MOVSS T1 ;HANDLE TO LEFT HALF
HRR T1,JFNX ;JFN TO RIGHT
GET ;GET THE FILE
ERJMP LOSE ;COULDN'T
MOVE T1,HANDLE ;FETCH FORK HANDLE
SETZ T2, ;NORMAL START
SFRKV ;START THE FORK UP
ERJMP LOSE ;CAN'T
WFORK ;WAIT FOR IT TO COME BACK
ERJMP LOSE ;TROUBLE
KFORK ;IS DONE, SO KILL IT
ERJMP LOSE ;FAILED
SETZM HANDLE ;NO MORE FORK
RETSKP ; AND COMMAND IS FINISHED
SUBTTL TAKE COMMAND
;TAKE COMMAND TO READ COMMAND FROM DESIGNATED FILE BY SETTING UP
;THE PRIMARY I/O JFNS TO POINT TO THE FILE.
;UNTAKE ROUTINE CALLED TO RESET THE STATE WHEN THE END OF THE TAKE
;FILE IS ENCOUNTERED.
.TAKE:: NOISE (COMMANDS FROM FILE) ;DO GUIDEWORDS
SETZM JFNBLK+.GJNAM ;CLEAR ANYTHING THAT MAY HAVE BEEN HERE
HRROI T2,[ASCIZ/CMD/] ;DEFAULT EXTENSION FOR FILE
MOVEM T2,JFNBLK+.GJEXT ;TO JFN BLOCK FOR GTJFN
MOVX T2,GJ%OLD ;FILE MUST EXIST
MOVEM T2,JFNBLK+.GJGEN
PARSE [FLDDB. (.CMFIL)] ;ASK FOR A FILE
MOVEM T2,JFNTMP ;SAVE JFN FOR A MOMENT
CONFRM ;CONFIRM THE COMMAND
SKIPE TAKJFN ;TEST--DON'T ALLOW NESTING
JRST [ TMSG <
? Nesting of TAKE files is not allowed -- command file aborted
>
CALL UNTAKE ;CLEAR STATE AND
JRST REEN] ;DIE SOMEHOW
HRRZ T1,JFNTMP ;GET BACK JFN
MOVEM T1,TAKJFN ;SAVE THE JFN
SETZM JFNTMP ; AND CLEAR THE TEMP SLOT
MOVX T2,FLD(7,OF%BSZ)+OF%RD ;READ AS ASCII FILE
OPENF ;OPEN IT
ERJMP LOSE ;FAILED
MOVEI T1,.FHSLF ;OUR PROCESS
GPJFN ;GET OLD PRIMARY I/O
MOVEM T2,OLDPRM ;SAVE FOR RESTORE
HRL T2,TAKJFN ;POINT TO TAKE FILE
SPJFN ; AS PRIMARY INPUT
ERJMP LOSE ;COULDN'T
MOVX T2,.NULIO ;MARK COMND BLOCK OUTPUT
HRRM T2,CMDBLK+.CMIOJ ; AS NUL SO DON'T GET PROMPTS
RET ;AND DONE--RESET AT EOF BY UNTAKE
;UNTAKE - ROUTINE CALLED TO UNDO THE EFFECTS OF THE TAKE COMMAND
;RESETS THE PRIMARY I/O AND CLEANS UP THE JFN.
UNTAKE: MOVEI T1,.PRIOU ;RESET COMND BLOCK OUTPUT DESIGNATOR
HRRM T1,CMDBLK+.CMIOJ ;SO WE GET OUR PROMPTS,... BACK
MOVEI T1,.FHSLF ;OUR PROCESS
SKIPE T2,OLDPRM ;OLD DESIGNATORS
SPJFN ;RESTORE
SETZM OLDPRM ;AND CLEAR
SKIPE T1,TAKJFN ;TAKE FILE JFN
CLOSF ;CLOSE IT
ERJMP .+1 ;IGNORE ERRORS (AND POSSIBLE LOSE LOOP)
SKIPE T1,TAKJFN ;GET JFN AGAIN
RLJFN ;RELEASE IT
ERJMP .+1
SETZM TAKJFN ;RESET TAKE STATE
RET ;DONE
SUBTTL LUUO HANDLER AND PROCESSING ROUTINES
;LUUOH - THIS IS THE UUO HANDLER
;CALLED BY A CALL LUUOH. PRESERVES T1-T4 HERE ON THE STACK
;TO SAVE EFFORT FOR THE PROCESSING ROUTINES. ALL PROCESSING
;ROUTINES SHOULD RETURN +1 FOR NOW, AND ALL UUOS.
;TO RETURN VALUES IN AC1-AC4, THE VALUES ON THE STACK MUST BE
;UPDATED.
LUUOH: ADJSP P,4 ;ALLOCATE SPACE ON THE STACK
DMOVEM T1,-3(P) ;SAVE T1,T2
DMOVEM T3,-1(P) ;SAVE T3,T4
PUSH P,.JBUUO ;SAVE 40 TO ALLOW RECURSION
LOAD T1,UUONUM ;GET THE UUO NUMBER
CAILE T1,UUOMAX ;OUT OF RANGE?
ERROR ZSUBS Internal Error - LUUO Out of Range
PUSH P,UUODSP(T1) ;DISPATCH TO PROPER ROUTINE
MOVE T1,-5(P) ; AFTER RESTORING T1
CALL @0(P) ;CALL THE ROUTINE
ADJSP P,-1 ;BUMP PAST CALL ADDRESS
POP P,.JBUUO ;RESTORE LAST VALUE, SOMEONE MAY NEED IT
DMOVE T1,-3(P) ;RESTORE T1,T2
DMOVE T3,-1(P) ;RESTORE T3,T4
ADJSP P,-4 ;DEALLOCATE STACK SPACE
RET ;AND RETURN FROM LUUO
;THE UUO DISPATCH TABLE - INDEX IS BY UUO NUMBER
UUODSP: EXP LOSFIN ;IN CASE SOMEONE GETS HERE
EXP PRTUUO ;PRINT
EXP TYPUUO ;TYPE
EXP WRNUUO ;WARN
EXP ERRUUO ;ERROR
EXP OCTUUO ;OCTOUT
EXP DECUUO ;DECOUT
EXP TOCTUU ;TOCT
EXP TDECUU ;TDEC
EXP TSPUUO ;TSPACE
EXP PSPUUO ;PSPACE
EXP PARUUO ;PARSE
EXP NOIUUO ;NOISE
EXP CFMUUO ;CONFIRM
EXP VERUUO ;VERSIO
EXP ABTUUO ;SETABT
EXP CLAUUO ;CLRABT
EXP LERUUO ;LERROR
EXP PRJUUO ;PRTJFN
EXP TYJUUO ;TYPJFN
UUOMAX==.-UUODSP-1 ;COUNT
SUBTTL ERROR AND NORMAL TEXT OUTPUT UUOS
;LERUUO - ROUTINE TO PROCESS THE LERROR UUO
;ERRUUO - ROUTINE TO PROCESS THE ERROR UUO
LERUUO: SKIPA T1,[EXP LOSE] ;TERMINATE AT LOSE FOR LERROR
ERRUUO: MOVEI T1,LOSFIN ;SETUP TO TRANSFER TO LOSFIN
EXCH T1,0(P) ;SET THE CLEANUP ROUTINE
HRRO T1,.JBUUO ;POINT TO THE STRING
ESOUT ;OUTPUT IT ESOUT MANNER
ERJMP .+1 ;GET TO TERMINATING ROUTINE
RET ;IN ANY CASE
;WRNUUO - ROUTINE TO PROCESS THE WARN UUO
WRNUUO: MOVX T1,.PRIOU ;SEE IF CRLF NEEDED
DOBE ; BY WAITING FOR OUTPUT TO FINISH AND
RFPOS ; BY GETTING POSITION
TRNE T2,-1 ;AT LEFT?
TYPE <
> ;DO THE CRLF
TYPE <% > ;DO THE PERCENT
; CALLRET TYPUUO ;AND THEN SAME AS TYPE (FALL THROUGH)
;TYPUUO - ROUTINE TO PROCESS THE TYPE UUO
TYPUUO: HRRO T1,-2(P) ;POINT TO THE STRING (HAVE TO USE SAVED .JBUUO)
PSOUT ;OUTPUT THE STRING
ERJMP LOSE ;HANDLE BAD ERRORS
RET ;AND RETURN TO CALLER
;PRTUUO - ROUTINE TO PROCESS THE PRINT UUO
;OUTPUTS TO THE JFN SET UP IN OJFN UNLESS IT IS ZERO, IN
;WHICH CASE .PRIOU IS USED
PRTUUO: SKIPN T1,OJFN ;GET THE OUTPUT JFN
MOVX T1,.PRIOU ;EITHER FILE OR TERMINAL
HRRO T2,.JBUUO ;POINT TO THE STRING
SETZ T3, ;ASCIZ
SOUT ;OUTPUT THE STRING
ERJMP LOSE ;BLOW UP ON ERRORS
RET ;AND RETURN TO THE CALLER
SUBTTL NUMERIC OUTPUT UUOS
;OCTUUO - ROUTINE TO PROCESS THE OCTOUT UUO
;DECUUO - ROUTINE TO PROCESS THE DECOUT UUO
;TOCTUU - ROUTINE TO PROCESS THE TOCT UUO
;TDECUU - ROUTINE TO PROCESS THE TDEC UUO
TOCTUU: ;SAME ENTRY POINT
OCTUUO: MOVE T2,@.JBUUO ;DO FETCH FIRST TO ALLOW USING ACS
MOVX T3,NO%MAG+^D8 ;OCTAL RADIX ENTRY
JRST NUMUUO ;ENTER COMMON CODE
TDECUU: ;SHARED ENTRY POINT
DECUUO: MOVE T2,@.JBUUO ;FETCH THE VALUE TO BE OUTPUT
MOVEI T3,^D10 ;DECIMAL RADIX ENTRY
NUMUUO: LOAD T1,UUOAC ;GET COLUMN SIZE, 0 TO 17
STOR T1,NO%COL,T3 ;SET UP THE COLUMNS FIELD
SKIPE T1 ;IF ZERO PASSED, NO FILL IS USED
TXO T3,NO%LFL ; ELSE ASK FOR LEADING SPACE FILL
LOAD T1,UUONUM ;GET THE UUO OPCODE
CAIE T1,<TOCT.>_<-^D27> ;TOCT OR
CAIN T1,<TDEC.>_<-^D27> ;TDEC?
SKIPA ;YES, USE .PRIOU
SKIPN T1,OJFN ;FETCH THE DESIRED
MOVX T1,.PRIOU ; OUTPUT DESIGNATOR
NOUT ;DO THE OUTPUT
ERJMP LOSE
HRRZS T3 ;JUST THE RADIX
CAIE T3,^D10 ;DECIMAL?
RET ;NO, RETURN
MOVEI T2,"." ;YES, GET A DECIMAL POINT
BOUT ; AND OUTPUT (T1 HAS CORRECT DESIGNATOR)
ERJMP LOSE
RET ;RETURN
;TSPUUO - ROUTINE TO PROCESS THE TSPACE UUO
;PSPUUO - ROUTINE TO PROCESS THE PSPACE UUO
PSPUUO: SKIPN T1,OJFN ;SELECT THE
TSPUUO: MOVX T1,.PRIOU ; PROPER DESIGNATOR
MOVX T2," " ;SPACE
HRRZ T3,.JBUUO ;NUMBER TO DO
JUMPE T3,R ;IF ZERO, DO NONE
PSPUUL: BOUT ;OUTPUT
ERJMP LOSE
SOJG T3,PSPUUL ;LOOP FOR THAT NUMBER
RET ;THEN RETURN
SUBTTL FILESPEC OUTPUT UUO
;TYJUUO - ROUTINE TO PROCESS THE TYPJFN UUO
TYJUUO: HRRZ T2,@.JBUUO ;DO ARGUMENT FETCH FIRST TO ALLOW ACS
MOVX T1,.PRIOU ;TYPE AT TERMINAL ONLY
JRST JFNUUO ; AND GO TO COMMON CODE
;PRJUUO - ROUTINE TO PROCESS THE PRTJFN UUO
PRJUUO: HRRZ T2,@.JBUUO ;FETCH ARGUMENT FIRST
SKIPN T1,OJFN ;LOAD UP PROPER
MOVX T1,.PRIOU ; OUTPUT DESIGNATOR
JFNUUO: LOAD T3,UUOAC ;SEE IF WANT FULL OR DEFAULT OUTPUT
SKIPE T3 ; BY TESTING AC FIELD
MOVX T3,JS%SPC!JS%OFL ;FULL SPECIFICATION WANTED
JFNS ;DO THE OUTPUT
ERJMP LOSE ;FAILED
RET ;RETURN TO CALLER
SUBTTL VERSION NUMBER OUTPUT UUO
;VERUUO - ROUTINE TO PROCESS THE VERSIO UUO
;
;OUTPUTS A "STANDARD" VERSION NUMBER FROM THE ADDRESSED LOCATION IN THE
;FORM MAJOR.MINOR(EDIT)-WHO WITH ZERO SUPPRESSION ON MINOR AND WHO FIELDS.
;RECOGNIZES AND HANDLES VI%DEC VERSION NUMBERS
VERUUO: MOVE T4,@.JBUUO ;DO FETCH FIRST TO ALLOW ACS
LOAD T2,VI%MAJ,T4 ;GET MAJOR VERSION LEVEL
CALL VN.OUT ;OUTPUT IN RIGHT RADIX
LOAD T2,VI%MIN,T4 ;GET MINOR VERSION LEVEL
JUMPE T2,VERUU1 ;DON'T BOTHER WITH IT IF ZERO
PRINT <.> ;TYPE THE DELIMITER
CALL VN.OUT ; AND THE MINOR VERSION IN RIGHT RADIX
VERUU1: PRINT <(> ;PRECEDER FOR THE EDIT NUMBER
LOAD T2,VI%EDN,T4 ;FETCH EDIT NUMBER
CALL VN.OUT ;OUTPUT IN RIGHT RADIX
PRINT <)> ; AND CLOSE THE PARENS
LOAD T2,VI%WHO,T4 ;FETCH THE WHO FIELD
JUMPE T2,R ;DONE IF ZERO
PRINT <-> ;DELIMIT THE WHO FIELD
CALL VN.OUT ; AND TYPE IT OUT
RET ; AND ALL DONE HERE
;VN.OUT -- OUTPUT THE VALUE IN T2 IN OCTAL OR DECIMAL ACCORDING
;TO THE SETTING OF VI%DEC IN T4.
VN.OUT: TXNN T4,VI%DEC ;DECIMAL VERSION NUMBERS?
JRST [ OCTOUT T2 ;NO, OCTAL
RET] ;DONE
SKIPN T1,OJFN ;FETCH THE DESIRED
MOVX T1,.PRIOU ; OUTPUT DESIGNATOR
MOVX T3,^D10 ;RADIX
NOUT ;DO THE OUTPUT WITHOUT THE POINT
ERJMP LOSE
RET ; AND DONE
SUBTTL PSI ROUTINE UUOS AND SUPPORT CODE
;ABTUUO - ROUTINE TO PROCESS THE SETABT UUO
;SETS EFFECTIVE ADDRESS OF THE UUO AS THE CONTROL-E ABORT ROUTINE
;ADDRESS AND SAVES KNOWN STACK VALUE IN SAVPSI.
ABTUUO: HRRZ T1,.JBUUO ;GET DESIRED ADDRESS
TXO T1,PC%USR ; AND ALWAYS USER MODE
MOVEM T1,ABTADR ;SET THE ABORT HANDLER ADDRESS
MOVE T1,[.TICCE,,INTCHN] ;ACTIVATE INTCHN ON
ATI ; CONTROL-E
ERJMP LOSE
MOVE T1,P ;COPY THE STACK POINTER
ADJSP T1,-10 ;CREATE A COPY OF IT BEFORE ALL THIS
MOVEM T1,SAVPSI ; TO SAVE A KNOWN STACK VALUE FOR CLEANUPS
RET ; AND ALL DONE
;CLAUUO - ROUTINE TO PROCESS THE CLRABT UUO
CLAUUO: MOVX T1,.TICCE ;SETUP TO CLEAR THE CONTROL-E
DTI ;DISABLE THE TERMINAL INTERRUPT
ERJMP LOSE
RET ; AND DONE
;ABTINT - HERE ON PSI INTERRUPT ON INTCHN FOR CONTROL-E ABORT.
;DEBREAK THROUGH ADDRESS IN ABTADR TO GET TO CLEANUP CODE.
;DISABLE THE CHARACTER INTERRUPT ON THE CHANNEL.
ABTINT: PUSH P,T1 ;GET A TEMP AC
SKIPN T1,ABTADR ;ADDRESS OF WHERE TO GO
ERROR PSI error - abort address not initialized
MOVEM T1,CHNPC1 ; IN PLACE OF RETURNING
MOVX T1,.TICCE ;CONTROL-E CODE
DTI ;DISABLE THE INTERRUPT NOW
ERJMP LOSE
POP P,T1 ;RESTORE TEMP AC
SETZM ABTADR ;INDICATE GOT THE INTERRUPT
DEBRK ;TERMINATE THE INTERRUPT
ERJMP LOSE ;FAILED
SUBTTL COMND JSYS LUUO ROUTINES
;PARUUO - ROUTINE TO PROCESS THE PARSE LUUO
;RETURNS VALUES IN T1-T3.
PARUUO: HRRZ T2,.JBUUO ;PICK UP THE ADDRESS OF THE DESCRIPTOR BLOCK
CALL DOPARS ;DO THE ACTUAL PARSE, HANDLE NOPARSE
DMOVEM T1,-6(P) ;SETUP TO RETURN T1,T2
MOVEM T3,-4(P) ; AND T3 TO CALLER
RET ;AND DONE
;NOIUUO - ROUTINE TO PROCESS THE NOISE UUO.
NOIUUO: HRRO T2,.JBUUO ;BUILD A POINTER TO THE GUIDEWORD STRING
MOVEM T2,NOIBLK+.CMDAT ;SET IT IN THE COMND BLOCK
MOVEI T2,NOIBLK ;POINT TO THE BLOCK
CALLRET DOPARS ;AND GO DO THE COMND JSYS
;CFMUUO - ROUTINE TO PROCESS THE CONFRM UUO.
CFMUUO: MOVEI T2,[FLDDB. (.CMCFM)] ;GET THE CONFIRM FUNCTION
; CALLRET DOPARS ;AND DO THE PARSE (FALL THROUGH)
;DOPARS - INTERNAL ROUTINE TO DO COMND JSYS AND HANDLE NOPARSE CASE.
; T2/ ADDRESS OF COMND DESCRIPTOR BLOCK
;
; CALL DOPARS
;
;RETURNS +1: ALWAYS ON SUCCESSFUL PARSE, OTHERWISE EXITS VIA LOSE
DOPARS: CALL COMMND ;MAKE THE COMND CALL
JRST LOSE ;BLOW UP ON ERRORS
RET ;AND RETURN +1 ON SUCCESS
;COMMND - CENTRAL ROUTINE TO PERFORM COMND JSYS CALL.
; T2/ ADDRESS OF COMND DESCRIPTOR BLOCK TO USE
;
; CALL COMMND
;
;RETURNS +1: ON NOPARSE
; +2: ON SUCCESSFUL PARSE
COMMND:: MOVEI T1,CMDBLK ;POINT TO OUR (ONLY) COMMAND BLOCK
COMND ;PARSE THE FUNCTION
ERJMP LOSE ;ERROR, GO COMPLAIN
TXNE T1,CM%NOP ;DID IT PARSE?
RET ;NO, COMPLAIN
RETSKP ;YES, RETURN SUCCESSFULLY
SUBTTL ERROR PROCESSING ROUTINES
;LOSE - GENERAL ROUTINE TO JRST/ERJMP TO. OUTPUTS ERSTR MESSAGE
;AND SIMULATES REENTER AT REPARSE ADDRESS -1.
LOSE:: SKIPE T1,TAKJFN ;TAKE IN PROGRESS?
JRST [ GTSTS ;YES--SEE IF EOF
TXNE T2,GS%EOF ;TEST BIT
JRST TAKEOF ;EOF
JRST .+1] ;OTHER ERROR, CONTINUE
HRROI T1,ERRBUF ;POINT TO ERROR BUFFER
HRLOI T2,.FHSLF ;LAST ERROR IN THIS FORK
HRLI T3,-TXTLEN ;MAX BYTES
ERSTR ;GET THE ERROR
ERJMP .+1 ;FAILED
ERJMP .+1 ;FAILED
HRROI T1,ERRBUF ;POINT TO ERROR MESSAGE AGAIN
ESOUT ;OUTPUT THE MESSAGE
SKIPE T1,OJFN ;TRY TO CLOSE OUTPUT IF
CLOSF ; HAPPENED TO BE OPEN
ERJMP .+1 ;TOO BAD ON CLOSE ERRORS
SKIPN TAKJFN ;NEED TO ABORT TAKE?
JRST LOSFIN ;NO
CALL UNTAKE ;YES--SO DO IT
TMSG < -- command file aborted> ;AND SAY SO
LOSFIN: TMSG <
> ;FINAL STRING CRLF
MOVX T1,.PRIIN ;GET READY
CFIBF ;CLEAR INPUT BUFFER
REEN: HRRZ T1,CMDBLK+.CMFLG ;GET REPARSE ADDRESS
JRST -1(T1) ;AND TRANSFER TO ONE LESS...
TAKEOF: CALL UNTAKE ;CLEAN UP TAKE STATE
TYPE <
[Command file completed]> ;SAY SO
JRST REEN ;AND REENTER COMMAND LOOP
SUBTTL THE DATA AREA
XLIST ;DUMP THE LITERALS
DLITS: LIT
LIST
;COMND VARIABLES
CMDBLK::0 ;ADDRESS OF REPARSE ROUTINE
.PRIIN,,.PRIOU ;INPUT,,OUTPUT JFNS
0 ;CONTROL-R POINTER/PROMPT
-1,,TXTBUF ;POINTER TO TEXT BUFFER
-1,,TXTBUF ;POINTER TO CURRENT POSITION
TXTLEN ;NUMBER OF CHARS IN BUFFER
0 ;NUMBER OF UNPARSED CHARACTERS
-1,,ATMBUF ;POINTER TO ATOM BUFFER
TXTLEN ;NUMBER OF CHARACTERS IN BUFFER
EXP JFNBLK ;POINTER TO GTJFN BLOCK
JFNBLK::GJ%OLD ;FLAGS,,GENERATION NUMBER
.PRIIN,,.PRIOU ;INPUT,,OUTPUT JFNS
BLOCK 20 ;NO DEFAULTS
JFNTMP::BLOCK 1 ;WORD FOR COMND'S JFNS RETURNED DURING PARSE
TXTBUF::BLOCK TXTLEN/5+1 ;BUFFER FOR COMMAND JSYS
ATMBUF::BLOCK TXTLEN/5+1 ;BUFFER FOR ATOM BUFFER
ERRBUF: BLOCK TXTLEN/5+1 ;BUFFER FOR ERROR MESSAGES
;GUIDEWORD DESCRIPTOR BLOCK USED BY NOISE ROUTINE
NOIBLK: FLDDB. (.CMNOI) ;BLOCK FOR NOISE FUNCTION
;PSI SYSTEM VARIABLES
LEVTAB::EXP CHNPC1 ;WHERE TO STORE PC FOR LEVEL ONE INTERRUPT
BLOCK 2 ;OTHER LEVELS UNUSED
CHNTAB::XWD 1,ABTINT ;VECTOR FOR INTERRUPT ON THIS CHANNEL
BLOCK ^D35 ;OTHER CHANNELS UNUSED
CHNPC1: BLOCK 1 ;INTERRUPT PC STORED HERE
SAVPSI::BLOCK 1 ;P SAVED HERE FOR ADJUST ON ^E
ABTADR: BLOCK 1 ;WHERE TO GO ON A ^E ABORT
JFNX: BLOCK 1 ;JFN ON EXEC TO PUSH TO
HANDLE: BLOCK 1 ;FORK HANDLE FOR INFERIOR EXEC
OLDPRM: BLOCK 1 ;STORAGE FOR OLD I/O DESIGNATORS DURING TAKE
TAKJFN: BLOCK 1 ;TAKE FILE JFN WHEN NONZERO
PDL:: BLOCK PDLSIZ ;STACK ROOM
OJFN:: BLOCK 1 ;OUTPUT FILE JFN
> ;END IFN REL
END