Trailing-Edge
-
PDP-10 Archives
-
BB-L054E-RK
-
glxext.mac
There are no other files named glxext.mac in the archive.
TITLE GLXEXT -- Extension to GALAXY Library routines
; ====== ------------------------------------
ENTRY A$INIT,A$PDFD,DEF$LN,GET$LN
ENTRY FMT$ER,FMT$FD,FMT$NU,FMT$OC,FMT$VR
ENTRY T$FD
ENTRY F$CHKS,F$VERS
ENTRY $ERR$C,$ERR$G,$ER$HK,$ER$IP,$ER$MP
SEARCH GLXMAC
PROLOG(EXT)
TOPS10 <IF1,<PRINTX [Assembling GLXEXT for TOPS-10]>>
TOPS20 <
IF1,<PRINTX [Assembling GLXEXT for TOPS-20]>
SEARCH MONSYM
.JBVER=137
>
SUBTTL Edit History
; ============
;
; Edit History for GLXEXT
;
; EXT001 by DRB on 14-Oct-80
; Added 3 character prefix code to error messages.
;
; EXT002 by DRB on 27-Oct-80
; Fixed routine F$VERS so that it will return version # from
; entry vector as well as .JBVER. Routines VRSADR and CVTADR
; were added.
;
; EXT003 by DRB on 30-Oct-80
; Fixed error routines so that they correctly determine if a
; CR_LF is required before the error message.
;
; EXT004 by DRB on 31-Oct-80
; Added error routine $ER$HK for invalid HELP keywords.
;
; EXT005 by DRB on 8-Dec-80
; Changed PRSDEF routine to ignore PPNs supplied with an
; ersatz device rather than issue an error message. Then the
; definition SYS:[1,4] would be legal.
;
; EXT006 by DRB on 26-Jan-81
; Changed BLDMSG routine to check for overflow beyond buffer
; area; also increased the size of BUF and NBUF, two buffers
; that were most likely to overflow.
;
; 066 by ESB on 21-Apr-82
; Get correct version number for EXE files with entry vectors.
; Make sure that the arguments to the POINT pseudo op are in decimal.
; CVTADR loses track of which page in the file it wants.
;
; 074 by ESB on 23-Jul-82
; Fix GET$LN for TOPS20. Use the AC with the updated pointer to
; append a null to the string.
EDTEXT=:74 ; Edit level of this module
;
; A$INIT()
;
; Here to do initialization processing
;
; For TOPS-20, access all pages up to the location of this routine.
; (assume this routine loaded last)
; Then when GALAXY memory manager goes looking for free pages,
; it won't try to use our pages of 0's as its own.
;
TOPS10 <
A$INIT:
$RETT
> ; END TOPS10 CONDITIONAL
TOPS20 <
A$INIT: MOVX S1,0 ; Initialize
A$IN.1: MOVE S2,(S1) ; Access memory
ADDI S1,1000 ; Next page
CAIGE S1,. ; Are we here?
JRST A$IN.1 ; No, do more.
$RETT
> ; END TOPS20 CONDITIONAL
;
; A$PDFD()
;
; Here to return an FD for a patch tape directory.
; S1 contains number of patch tape (range 0-99)
;
; Returns address of FD
;
TOPS10 <
A$PDFD: ADDI S1,^D100 ; Convert to form 1nn
SETZM NBUF ; Clean things up
$TEXT (<-1,,NBUF>,<^D/S1/^0>) ; Convert to ASCII
MOVEI S1,NBUF ; Point to ASCIZ string
$CALL S%SIXB ; Convert to SIXBIT
HLRM S2,DPD.FD+.FDNAM ; Plug into FD
MOVEI .SAC,DPD.FD ; Point to TOPS-10 FD
$RET
DPD.FD: $BUILD (FDXSIZ)
$SET (.FDLEN,,<XWD FDXSIZ,0>)
$SET (.FDSTR,,SIXBIT/PAT/)
$SET (.FDNAM,,SIXBIT/PAT000/)
$SET (.FDEXT,,SIXBIT/DPD/)
$EOB
> ; END TOPS10 CONDITIONAL
TOPS20 <
A$PDFD: ADDI S1,^D200 ; Convert to form 2nn
$TEXT (<-1,,DPD.FD+1>,<PAT:PAT^D/S1/.DPD^A>)
MOVEI .SAC,DPD.FD ; Point to TOPS-20 FD
$RET
FDSIZ==5 ; For this FD
DPD.FD: XWD FDSIZ,0
ASCIZ /PAT:PAT000.DPD/
> ; END TOPS20 CONDITIONAL
;
; DEF$LN()
;
; Here to define a logical name
; S1 contains address of ASCIZ string giving logical name
; S2 contains address of ASCIZ string giving definition
;
; defn1,defn2,...
; where defn can be dev:[path] or
; a logical name in the form dev:
; (no defaults are supplied to complete a dev:[path] defn)
;
; Returns TRUE or FALSE in AC0
; Returns address of error message in S1 on false return
;
TOPS10 <
DEF$LN: PUSHJ P,.SAVE4 ; Save P1-4
DMOVE P1,S1 ; Save S1,S2
HRLI S1,(POINT 7) ; Convert to byte pointer
MOVEM S1,XXXPTR ; Save it
PUSHJ P,FTOKEN ; Convert logical name to SIXBIT
JUMPE T1,[MOVEI S1,[ASCIZ/Invalid logical name/]
$RETF]
MOVE P4,T1 ; Save it
MOVEI S1,.PTLLB+1 ; Clear out PATH. argument block
MOVEI S2,PATH
PUSHJ P,.ZCHNK
MOVEI P3,PATH ; Get address of PATH block
MOVX T1,.PTFSN ; Function to setup/delete logical name
MOVEM T1,.PTFCN(P3) ; to argument block
MOVEM P4,.PTLNM(P3) ; Logical name to argument block
ADDI P3,.PTLSB ; Point P3 to first group
DMOVE S1,P1 ; Get back S1,S2
HRLI T1,(POINT 7) ; Setup a byte pointer
HRR T1,S2 ; to ASCIZ string defining logical name
MOVEM T1,XXXPTR ; Save pointer
DEF$L1: PUSHJ P,PRSDEF ; Parse a definition
JUMPF .POPJ ; Failed
ILDB S1,XXXPTR ; Get next byte
JUMPE S1,DEF$L2 ; Done if end of string
CAIE S1,","
JRST [MOVEI S1,[ASCIZ/Invalid separator between groups/]
$RETF]
MOVEI P3,1(T2) ; Otherwise point to next group in block
JRST DEF$L1 ; And continue
;
;
DEF$L2: ; Parse completed
MOVE T1,P4 ; Logical name to T1
PUSHJ P,DEL.LN ; Delete old logical name (if any)
MOVEI T1,PATH ; Define new logical name
HRLI T1,.PTLLB+1 ; Argument block length
PATH. T1,
JRST [PUSHJ P,PTHERR ; Failed
$RETF]
$RETT
;
; Here to delete a logical name definition
; T1 contains logical name in SIXBIT
;
; Returns TRUE or FALSE in AC0
; Returns address of error message in S1 on false return
;
; On error return, S1 contains address of error message
;
DEL.LN:
PUSHJ P,.SAVE1 ; Save P1
MOVE P1,T1 ; Save logical name
MOVEI S1,.PTLZT+1 ; Clear out PATH. argument block
MOVEI S2,DPATH
PUSHJ P,.ZCHNK
MOVEI T1,DPATH ; Get address of PATH block
MOVX T2,.PTFSN ; Function to setup/delete logical name
MOVEM T2,.PTFCN(T1) ; to argument block
MOVX T2,PT.UDF ; Flag to delete logical name
MOVEM T2,.PTLNF(T1) ; to argument block
MOVEM P1,.PTLNM(T1) ; Logical name to argument block
HRLI T1,.PTLZT+1 ; Length of argument block
PATH. T1,
JRST [PUSHJ P,PTHERR ; Failed
$RETF]
$RETT
;
; Here to get default path for a device
; T1 contains device name in SIXBIT
;
; Returns TRUE or FALSE in AC0
; Returns address of error message in S1 on false return
;
; On error return, S1 contains address of error message
;
; On exit
; DPATH is the completed PATH. block
;
GET.DP:
PUSHJ P,.SAVE1 ; Save P1
MOVE P1,T1 ; Save logical name
MOVEI S1,.PTMAX+1 ; Clear out PATH. argument block
MOVEI S2,DPATH
PUSHJ P,.ZCHNK
MOVEI T1,DPATH ; Get address of PATH block
MOVEM P1,.PTFCN(T1) ; Logical name to argument block
HRLI T1,.PTMAX+1 ; Length of argument block
PATH. T1,
JRST [PUSHJ P,PTHERR ; Failed
$RETF]
$RETT
;
; Parse a definition of dev:[path] or logical name dev:
; and build PATH. block
;
; If dev: is an ersatz device with an implied PPN,
; any specified PPN will be ignored.
;
; XXXPTR points to string
; on return XXXPTR points to terminating character
; P3 points to current group in PATH. argument block
; on return T2 points to terminating 0 word of last
; SFD spec in block
;
; On false return, S1 contains address of error message
;
PRSDEF: PUSHJ P,.SAVE2 ; Save P1-P2
PUSHJ P,FTOKEN ; Parse device
JUMPE T1,PRS.E1 ; Error if null
LDB S1,XXXPTR ; Check terminator
CAIE S1,":" ; Valid for a device ?
JRST PRS.E1 ; No
MOVE P1,T1 ; Save device
$CALL GET$L0 ; See if this is a logical name
JUMPF PRS.1 ; No, see if ersatz device
MOVEI T3,GPATH ; Yes; Setup to use this definition
SUBI T1,.PTLSB+1(T3) ; Get number of words
MOVE T2,T1 ; in T2
HRLI T3,.PTLSB(T3) ; Source of definition
HRR T3,P3 ; Destination for definition
ADDI T2,(P3) ; Point to SFD terminator in block
BLT T3,(T2)
$RETT ; Return
PRS.1: MOVEM P1,.PTLSL(P3) ; Save device in argument block
MOVE T1,P1 ; Device name
$CALL GET.DP ; Get default path for this device
MOVEI T1,DPATH ; Start of block
MOVE T2,.PTSWT(T1) ; Get flags
TXNN T2,PT.IPP ; See if device has implied PPN
JRST PRS.2 ; No, must parse path spec.
MOVE T2,.PTPPN(T1) ; Yes, use implied PPN
MOVEM T2,.PTLPP(P3) ; as PPN
MOVE T1,XXXPTR ; Get byte pointer
MOVEI T2,EBUF ; Point to dummy destination area
PUSHJ P,PTHPRS ; Parse path spec if one is supplied
JFCL ; but ignore it and any errors
; (This updates XXXPTR)
MOVEI T2,.PTLSF(P3) ; Point to valid terminator
$RETT ; Good return
;
;
PRS.2: MOVE T1,XXXPTR ; Pickup byte pointer to string
MOVEI T2,.PTLPP(P3) ; Point to destination area in block
PUSHJ P,PTHPRS ; Parse Path Spec
JRST [MOVEI S1,[ASCIZ/Invalid PATH specification/]
$RETF]
$RETT ; Return
PRS.E1: MOVEI S1,[ASCIZ/Invalid device/]
$RETF
;
; Routine to parse path specification and build PATH. block
; string is in form [p,pn,a,b,c,d,e] (no defaults supplied)
;
; T1 contains Byte Pointer to String
; T2 contains Destination Address (should be .PTLPP of PATH group)
;
; Uses T1-T4 and XXXPTR
;
; Returns TRUE as a skip return
; PPN and Path Stored Via Calling Arg in T2
; XXXPTR Pointing to Terminating byte ("]") in String
; T2 pointing to terminating word (0) in PATH. block
;
; Returns FALSE as a non-skip return
;
PTHPRS: ILDB S1,T1 ; Load first byte
CAIE S1,"[" ; Must be bracket
POPJ P,0 ; Else fail
PUSHJ P,.SAVE2 ; Preserve P1-P2
HRRZ P2,T2 ; Get destination address
MOVEI P1,.PTLEL-.PTLSF ; Get maximum depth
MOVE S1,T1 ; Get the pointer
MOVEI S2,^D8 ; Set octal radix
$CALL S%NUMI ; Get project number
JUMPF .POPJ ; Failed
HRLM S2,(P2) ; Save in .PTLPP
LDB T1,S1 ; Get terminator
CAIE T1,"," ; Must be comma
POPJ P,0 ; Failed
MOVEI S2,^D8 ; Set octal radix
$CALL S%NUMI ; Get programmer number
JUMPF .POPJ ; Failed
HRRM S2,(P2) ; Save in .PTLPP
MOVEM S1,XXXPTR ; Store updated pointer
PATH.1: ADDI P2,1 ; Next field in PATH. block
LDB T1,XXXPTR ; Get terminator
CAIN T1,"]"
JRST PATH.2 ; End of specification
CAIE T1,"," ; Must be comma or bracket
POPJ P,0 ; Failed
PUSHJ P,FTOKEN ; Get token
JUMPE T1,.POPJ ; Fail if 0
MOVEM T1,(P2) ; Store in PATH. block
SOJG P1,PATH.1 ; Repeat until maximum depth
POPJ P,0 ; Too deep
PATH.2: MOVE T2,P2 ; T2 points to terminating zero
AOS 0(P) ; Give good return
POPJ P,
;
; Routine to get a SIXBIT token
; XXXPTR contains byte pointer to string
;
; On return
; XXXPTR points to field terminator
; T1 contains SIXBIT token
;
FTOKEN: SETZM T1 ;CLEAR RESULT
MOVE T3,[POINT 6,T1] ;AND POINT TO STORAGE AREA
FTOK.1: ILDB T2,XXXPTR ;GET A BYTE
PUSHJ P,C7TO6 ;CONVERT TO SIXBIT
CAIG T2,'Z' ;IS IT IN RANGE?
CAIGE T2,'0' ;
POPJ P,0 ;NO
CAILE T2,'9' ;
CAIL T2,'A' ;
SKIPA
POPJ P,0
TXNE T3,<INSVL.(77,BP.POS)> ;IS THERE ROOM?
IDPB T2,T3 ;YES,STORE IT
JRST FTOK.1 ;TRY ANOTHER
C7TO6: CAIL T2,"a" ;IS IT LC?
SUBI T2,40 ;YES
SUBI T2," " ;CONVERT TO SIXBIT
ANDI T2,77 ;MASK IT AND
POPJ P, ;RETURN
;
; Data required for TOPS-10 logical names
;
$DATA XXXPTR ; Byte pointer for parsing
$DATA PATH,.PTLLB+1 ; PATH block to define logical name
$DATA DPATH,.PTLZT+1 ; PATH block to delete logical name
$DATA GPATH,.PTLLB+1 ; PATH block to get logical name defn
> ; END TOPS10 CONDITIONAL
;
; DEF$LN()
;
; Here to define a logical name
; S1 contains address of ASCIZ string giving logical name
; S2 contains address of ASCIZ string giving definition
; Returns TRUE or FALSE in AC0
; Returns address of error message in S1 on false return
;
TOPS20 <
DEF$LN: HRLI S1,(POINT 7) ; Convert to byte pointer
HRLI S2,(POINT 7)
MOVE T1,S2 ; Setup for JSYS
MOVE S2,S1
MOVEI S1,.CLNJB ; Function code
CRLNM ; Try to do define
ERJMP [MOVE S2,S1 ; Get error code
HRLI S2,.FHSLF ; me
MOVEI S1,EBUF ; Message buffer is
HRLI S1,-1 ; destination designator
HRLZI T1,-120 ; 80 char limit
ERSTR
ERCAL [POPJ P,]
ERCAL [POPJ P,]
MOVEI S1,EBUF ; Point to error message
$RETF] ; CRLNM failed
$RETT ; Succeeds
> ; END TOPS20 CONDITIONAL
;
; GET$LN()
;
; Here to return string associated with a logical name
; S1 contains address of ASCIZ string giving logical name
; Returns TRUE or FALSE in AC0
; Returns address of ASCIZ string in S1 on true return
; Returns address of ASCIZ error string in S1 on false return
;
; On exit
; GPATH is the completed PATH. block for this logical name
; T1 points to first word of double 0 terminator for block
;
TOPS10 <
GET$LN: HRLI S1,(POINT 7) ; Convert to byte pointer
MOVEM S1,XXXPTR ; Save it
PUSHJ P,FTOKEN ; Convert logical name to SIXBIT
JUMPE T1,[MOVEI S1,[ASCIZ/Invalid logical name/]
$RETF]
GET$L0: PUSHJ P,.SAVE2 ; Save P1,P2
MOVE P1,T1 ; Save logical name
MOVEI S1,.PTLLB+1 ; Clear out PATH. argument block
MOVEI S2,GPATH
PUSHJ P,.ZCHNK
MOVEI T2,GPATH ; Point to PATH. argument block
MOVEM P1,.PTLNM(T2) ; Logical name to argument block
MOVEI T1,.PTFRN ; Read logical name function
MOVEM T1,.PTFCN(T2) ; to argument block
MOVX T1,PT.RCN ; Flag to retrieve data for this name
MOVEM T1,.PTLNF(T2) ; to argument block
HRLI T2,.PTLLB+1 ; Length of argument block
PATH. T2,
JRST [MOVE T1,T2 ; Failed
PUSHJ P,PTHERR
$RETF]
MOVEI T1,BUF ; Set up
HRLI T1,(POINT 7) ; pointer
MOVEM T1,BLDMPT ; to build ASCIZ string
MOVEI T1,GPATH+.PTLSB ; Point to first logical name group
GET$L1: PUSHJ P,DSPPTH ; Do this group
ADDI T1,1 ; Point to next possible group
DMOVE P1,(T1) ; Check for terminator
JUMPE P2,GET$L2 ; Done when double 0 terminator found
$TEXT (BLDMSG,<,^A>) ; Otherwise do next group
JRST GET$L1
GET$L2: $TEXT (BLDMSG,<^0>) ; Terminate ASCIZ string
MOVEI S1,BUF ; Setup for return
$RETT
;
; Routine to format up string from path block
; T1 points to SFD group
; on return T1 points to terminating word of SFD group
;
; This routine requires that BLDMPT be already setup
;
DSPPTH: HLRZ T3,.PTLPP(T1) ; Get project number
HRRZ T4,.PTLPP(T1) ; Get programmer number
$TEXT (BLDMSG,<^W/.PTLSL(T1)/:[^O/T3/,^O/T4/^A>)
ADDI T1,.PTLSF ; T1 now points to SFD
DSP.1: MOVE T2,(T1) ; Terminator
JUMPE T2,DSP.2 ; Yes, done
$TEXT (BLDMSG,<,^W/T2/^A>)
ADDI T1,1
JRST DSP.1
DSP.2: $TEXT (BLDMSG,<]^A>)
POPJ P,
;
; Error routine for PATH.
; T1 contains returned error code
; On exit, S1 points to error message
;
PTHERR: MOVEI S1,[ASCIZ/PATH. UUO failed/]
CAIN T1,PTTME%
MOVEI S1,[ASCIZ/Too many entries in PATH. block/]
CAIN T1,PTTMN%
MOVEI S1,[ASCIZ/Too many logical names defined/]
CAIN T1,PTNSN%
MOVEI S1,[ASCIZ/Attempt to delete nonexistent name/]
CAIN T1,PTNFS%
MOVEI S1,[ASCIZ/No per-process free core/]
CAIN T1,PTANE%
MOVEI S1,[ASCIZ/Tried to define a name that already exists/]
POPJ P,
> ; END TOPS10 CONDITIONAL
;
; GET$LN()
;
; Here to return string associated with a logical name
; S1 contains address of ASCIZ string giving logical name
; Returns TRUE or FALSE in AC0
; Returns address of ASCIZ string in S1 on true return
; Returns address of ASCIZ error string in S1 on false return
;
TOPS20 <
GET$LN: HRLI S1,(POINT 7) ; Convert to byte pointer
MOVE S2,S1
MOVE T1,[POINT 7,BUF] ; Where to return string
MOVEI S1,.LNSJB ; Function code (this job)
LNMST ; See if defined
ERJMP [MOVE S2,S1 ; Get error code
HRLI S2,.FHSLF ; me
MOVEI S1,EBUF ; Message buffer is
HRLI S1,-1 ; destination designator
HRLZI T1,-120 ; 80 char limit
ERSTR
ERCAL [POPJ P,]
ERCAL [POPJ P,]
MOVEI S1,EBUF ; Point to error message
$RETF] ; LNMST failed
SETZM T2
;**;[074] Change at GET$LN (for TOPS20) +16L
;**;[074] Use updated pointer to BUF to append null, not some random AC
IDPB T2,T1 ; [074] Add on zero byte
MOVEI S1,BUF ; Point to definition
$RETT ; Succeeds
> ; END TOPS20 CONDITIONAL
;
; F$CHKS()
;
; Here to get sequential checksum of a file
; (File must already be opened with 36 bit byte size)
;
; S1 contains IFN of the file
;
; Returns TRUE or FALSE in AC0
; On TRUE return S2 contains sequential checksum of file
; On FALSE return S1 contains GALAXY error code
;
F$CHKS: PUSHJ P,.SAVE2 ; Get 2 scratch registers
MOVE P1,S1 ; Save S1
SETZM P2 ; Initialize checksum
SETZM S2 ; Beginning of file
$CALL F%POS ; Rewind
JUMPF .RETF ; Failed
F$CHK1: MOVE S1,P1 ; Get back IFN of file
$CALL F%IBUF ; Get a buffer
JUMPF F$CHK3
F$CHK2: ILDB T1,S2 ; Get word
EXCH T1,P2 ; Checksum so far
ROT T1,1 ; Rotate
ADD T1,P2 ; Add this word
EXCH T1,P2 ; Save this
SOJG S1,F$CHK2 ; Do all of buffer
JRST F$CHK1 ; Do all of file
F$CHK3: CAIE S1,EREOF$ ; EOF?
$RETF ; No.
HLRZ S2,P2 ; Combine halves
HRRZ S1,P2
ADD S1,S2 ; Add
HLRZ S2,S1 ; Get carry
ADDI S2,(S1) ; Combine
$RETT ; Got it
;
; F$VERS()
;
; Here to get the version number directly from an EXE file
; (File must already be opened with 36 bit byte size)
;
; S1 contains IFN of the file
;
; Returns TRUE or FALSE in AC0
; On TRUE return S2 contains contents of version number word
; On FALSE return S1 contains GALAXY error code
; (S1 = 1000 (ERNEF$) if not .EXE format)
;
ERNEF$=1000 ; Define our own error code
F$VERS: PUSHJ P,.SAVE1 ; Get scratch register
MOVE P1,S1 ; Save S1
PUSHJ P,VRSADR ; Get address of version number word
JUMPF .RETF ; Failed
MOVE S1,P1 ; Get IFN of file
PUSHJ P,CVTADR ; Convert memory address to file address
JUMPF .RETF ; Failed
MOVE S1,P1 ; Get IFN of file
$CALL F%POS ; Position file to this word
JUMPF .RETF ; Failed
MOVE S1,P1 ; Get back IFN of file
$CALL F%IBYT ; Read version number word
JUMPF .RETF ; Failed
$RETT ; Got it
;
; Here to get the address of the version number directly from
; an EXE file. The version number will be in .JBVER unless
; there is an entry vector section (code 1775) in the EXE
; file directory area. If the entry vector section contains
; 254000 (octal) for the length, then the version number will
; be in .JBVER. Otherwise, the version number will be at the
; entry vector + 2.
;
; (File must already be opened with 36 bit byte size)
;
; S1 contains IFN of the file
;
; Returns TRUE or FALSE in AC0
; On TRUE return S2 contains address of version number word
; On FALSE return S1 contains GALAXY error code
; (S1 = 1000 (ERNEF$) if not .EXE format)
;
VRSADR: PUSHJ P,.SAVE2 ; Get 2 scratch registers
MOVE P1,S1 ; Save S1
SETZM P2 ; Position within file
SETZM S2 ; Beginning of file
VRSA.1: MOVE S1,P1 ; Get back IFN of file
ADDB S2,P2 ; Update pointer to next section
$CALL F%POS ; Position to byte
JUMPF .RETF ; Failed
MOVE S1,P1 ; Get back IFN of file
$CALL F%IBYT ; Read section header word
JUMPF .RETF ; Failed
MOVEI S1,ERNEF$ ; Setup for error just in case
HLRZ T1,S2 ; Identifier code
HRRZ S2,S2 ; Count of words
CAIN T1,1776 ; Directory section?
JRST VRSA.1 ; Yes, go on to next section!
CAIN T1,1777 ; Terminating section?
JRST VRSA.2 ; Yes, version number in .JBVER!
CAIE T1,1775 ; Entry vector section?
$RETF ; No--must be error!
; Yes--read entry vector section
MOVE S1,P1 ; Get back IFN of file
$CALL F%IBYT ; Read entry vector count from file
JUMPF .RETF ; Failed
CAIN S2,254000 ; A real entry vector count
JRST VRSA.2 ; No, version number in .JBVER
MOVE S1,P1 ; Get back IFN of file
$CALL F%IBYT ; Read entry vector address from file
JUMPF .RETF ; Failed
ADDI S2,2 ; Add offset to version word
$RETT
VRSA.2: MOVEI S2,.JBVER ; Version number will be in .JBVER
$RETT
;
; Here to convert a process address into an EXE file word
; address.
;
; (File must already be opened with 36 bit byte size)
;
; S1 contains IFN of the file
; S2 contains process address
;
; Returns TRUE or FALSE in AC0
; On TRUE return S2 contains file address
; On FALSE return S1 contains GALAXY error code
; (S1 = 1000 (ERNEF$) if not .EXE format)
;
CVTADR: PUSHJ P,.SAVE4 ; Get 4 scratch registers
MOVE P1,S1 ; Save S1
MOVE P2,S2 ; From target address
LSH P2,^D-9 ; page # in P2
LDB P3,[POINT ^D9,S2,^D35] ;[066] offset within page in P3
SETZM S2 ; Beginning of file
$CALL F%POS ; Position to byte
JUMPF .RETF ; Failed
MOVE S1,P1 ; Get back IFN of file
$CALL F%IBYT ; Read section header word
JUMPF .RETF ; Failed
MOVEI S1,ERNEF$ ; Setup for error just in case
HLRZ S2,S2 ; Identifier code
CAIE S2,1776 ; Directory section?
$RETF ; No, error!
CVTA.1: MOVE S1,P1 ; Get back IFN of file
$CALL F%IBYT ; Read first word of pair
JUMPF .RETF ; Failed
LDB P4,[POINT ^D27,S2,^D35] ;[066] File page # to P4
MOVE S1,P1 ; Get back IFN of file
$CALL F%IBYT ; Read second word of pair
JUMPF .RETF ; Failed
LDB T1,[POINT ^D27,S2,^D35] ;[066] Process page # to T1
LDB T2,[POINT ^D9,S2,^D8] ;[066] Repeat count to T2
CAMGE P2,T1 ; Address in range?
$RETF ; No--error
ADD T2,T1 ;[066] Add in upper limit
CAMLE P2,T2 ;[066] Still in range?
JRST CVTA.1 ; No--try next word pair
SUB T1,P2 ;[066] Page offset to T1
MOVN T1,T1 ;[066]
MOVE S2,P4 ; Yes--pick up page # in file
ADD S2,T1 ;[066] Add page offset
LSH S2,^D9 ; Convert to address
ADD S2,P3 ; Add address offset to page.
$RETT
;
; Parser error processing routines
; called as co routines during parse
;
$ERR$C: PUSHJ P,.SAVE4 ; SAVE P1-4
HRLI P1,(POINT 7,0) ; SET UP BYTE POINTER
HRRI P1,EBUF ; TO EBUF
MOVEM P1,BLDMPT ; SAVE IT
HRRZ P3,CR.FLG(S2) ; ADDRESS OF COMMAND STATE BLOCK
HLRZ P1,CR.PDB(S2) ; ADDRESS OF FDB IN PDB
MOVE P1,.CMDAT(P1) ; ADDRESS OF KEYWORD TABLE
$CALL K%TPOS ; Get current cursor position
CAIE S1,0 ; Are we at beginning of line?
$TEXT (BLDMSG,<>) ; No, give cr lf first
$TEXT (BLDMSG,<?URC Unrecognized command - ^Q/.CMABP(P3)/^A>)
MOVE S1,P1 ; ADDRESS OF TABLE
MOVE S2,.CMABP(P3) ; POINTER TO KEYWORD STRING
$CALL S%TBLK ; LOOK UP INVALID COMMAND
TXNE S2,TL%AMB ; AMBIGUOUS
$TEXT (BLDMSG,< is an ambiguous abbreviation^A>)
$TEXT (BLDMSG,<^0>) ; Make ASCIZ string
MOVEI S2,EBUF
$RETF
$ERR$G: MOVEI S2,[ASCIZ/?URC Unrecognized command - terminated by extraneous text/]
$RETF
$ER$MP: PUSHJ P,.SAVE4 ; SAVE P1-4
HRLI P1,(POINT 7,0) ; SET UP BYTE POINTER
HRRI P1,EBUF ; TO EBUF
MOVEM P1,BLDMPT ; SAVE IT
HRRZ P3,CR.FLG(S2) ; ADDRESS OF COMMAND STATE BLOCK
HLRZ P1,CR.PDB(S2) ; ADDRESS OF FDB IN PDB
MOVE P1,.CMDAT(P1) ; ADDRESS OF KEYWORD TABLE
$CALL K%TPOS ; Get current cursor position
CAIE S1,0 ; Are we at beginning of line?
$TEXT (BLDMSG,<>) ; No, give cr lf first
MOVE P4,.CMABP(P3) ; Get byte pointer
ILDB P4,P4 ; Get first byte
JUMPE P4,ER$MP1 ; Null product name
$TEXT (BLDMSG,<?UPN Unrecognized product name - ^Q/.CMABP(P3)/^A>)
MOVE S1,P1 ; ADDRESS OF TABLE
MOVE S2,.CMABP(P3) ; POINTER TO KEYWORD STRING
$CALL S%TBLK ; LOOK UP INVALID KEYWORD
TXNE S2,TL%AMB ; AMBIGUOUS
$TEXT (BLDMSG,< is an ambiguous product abbreviation^A>)
SKIPA
ER$MP1: $TEXT (BLDMSG,<?NPS No product name specified^A>)
$TEXT (BLDMSG,<^0>)
MOVEI S2,EBUF
$RETF
$ER$IP: PUSHJ P,.SAVE4 ; SAVE P1-4
HRLI P1,(POINT 7,0) ; SET UP BYTE POINTER
HRRI P1,EBUF ; TO EBUF
MOVEM P1,BLDMPT ; SAVE IT
HRRZ P3,CR.FLG(S2) ; ADDRESS OF COMMAND STATE BLOCK
HLRZ P1,CR.PDB(S2) ; ADDRESS OF FDB IN PDB
MOVE P1,.CMDAT(P1) ; ADDRESS OF KEYWORD TABLE
$CALL K%TPOS ; Get current cursor position
CAIE S1,0 ; Are we at beginning of line?
$TEXT (BLDMSG,<>) ; No, give cr lf first
MOVE P4,.CMABP(P3) ; Get byte pointer
ILDB P4,P4 ; Get first byte
JUMPE P4,ER$IP2 ; Null product name
$TEXT (BLDMSG,<?UPN Unrecognized product name - ^Q/.CMABP(P3)/^A>)
MOVE S1,P1 ; ADDRESS OF TABLE
MOVE S2,.CMABP(P3) ; POINTER TO KEYWORD STRING
$CALL S%TBLK ; LOOK UP INVALID KEYWORD
TXNN S2,TL%AMB ; Ambiguous?
JRST ER$IP1 ; No!
$TEXT (BLDMSG,< is an ambiguous product abbreviation^A>)
JRST ER$IP3
ER$IP1: MOVEI S1,MP%TBLUK## ; Address of Master Product table
MOVE S2,.CMABP(P3) ; Pointer to keyword string
$CALL S%TBLK ; Look up invalid keyword
TXNE S2,TL%ABR!TL%EXM ; Legal entry here?
$TEXT (BLDMSG,< is not a SELECTed product^A>)
SKIPA
ER$IP2: $TEXT (BLDMSG,<?NPS No product name specified^A>)
ER$IP3: $TEXT (BLDMSG,<^0>)
MOVEI S2,EBUF
$RETF
$ER$HK: PUSHJ P,.SAVE4 ; SAVE P1-4
HRLI P1,(POINT 7,0) ; SET UP BYTE POINTER
HRRI P1,EBUF ; TO EBUF
MOVEM P1,BLDMPT ; SAVE IT
HRRZ P3,CR.FLG(S2) ; ADDRESS OF COMMAND STATE BLOCK
HLRZ P1,CR.PDB(S2) ; ADDRESS OF FDB IN PDB
MOVE P1,.CMDAT(P1) ; ADDRESS OF KEYWORD TABLE
$CALL K%TPOS ; Get current cursor position
CAIE S1,0 ; Are we at beginning of line?
$TEXT (BLDMSG,<>) ; No, give cr lf first
MOVE P4,.CMABP(P3) ; Get byte pointer
ILDB P4,P4 ; Get first byte
JUMPE P4,ER$HK1 ; Null product name
$TEXT (BLDMSG,<?UHT Unrecognized HELP topic - ^Q/.CMABP(P3)/^A>)
MOVE S1,P1 ; ADDRESS OF TABLE
MOVE S2,.CMABP(P3) ; POINTER TO KEYWORD STRING
$CALL S%TBLK ; LOOK UP INVALID KEYWORD
TXNE S2,TL%AMB ; AMBIGUOUS
$TEXT (BLDMSG,< is an ambiguous keyword abbreviation^A>)
SKIPA
ER$HK1: $TEXT (BLDMSG,<?NTS No HELP topic specified^A>)
$TEXT (BLDMSG,<^0>)
MOVEI S2,EBUF
$RETF
;
; Routine to build a message
; BLDMPT contains destination byte pointer
; S1 contains character to output
;
BLDMPT: BLOCK 1 ; Destination byte pointer
BLDMSG: PUSHJ P,.SAVE1 ; Get a register
MOVE P1,BLDMPT ; Get current byte pointer
IBP P1 ; an bump it
HRRZ P1,P1 ; Get address
CAIL P1,BUFEND ; Still in range?
$RETF ; No--return
IDPB S1,BLDMPT ; Yes--stash character
$RETT
;
; FMT$ER()
;
; Format a GALAXY error message from error number
; S1 contains error number
; Returns address of formatted ASCIZ string in AC0
;
FMT$ER: $TEXT(<-1,,EBUF>,^E/S1/^0)
MOVEI .SAC,EBUF
$RET
;
; FMT$FD()
;
; Format a file spec from an FD
; S1 contains address of FD
; Returns address of formatted ASCIZ string in AC0
;
FMT$FD: $TEXT(<-1,,BUF>,^F/@S1/^0)
MOVEI .SAC,BUF
$RET
;
; FMT$NU()
;
; Format a number
; S1 contains number
; Returns address of formatted ASCIZ string in AC0
;
FMT$NU: $TEXT(<-1,,NBUF>,^D/S1/^0)
MOVEI .SAC,NBUF
$RET
;
; FMT$OC()
;
; Format an octal number
; S1 contains number
; Returns address of formatted ASCIZ string in AC0
;
FMT$OC: $TEXT(<-1,,OBUF>,^O/S1/^0)
MOVEI .SAC,OBUF
$RET
;
; FMT$VR()
;
; Format a version number
; S1 contains version number value
; Returns address of formatted ASCIZ string in AC0
;
FMT$VR: $TEXT(<-1,,NBUF>,^V/S1/^0)
MOVEI .SAC,NBUF
$RET
;
; Type a file spec from an FD
; S1 contains address of FD
;
T$FD: $TEXT(,^F/@S1/^A)
$RETT
BUF: BLOCK 44 ; Buffer for 180 characters
EBUF: BLOCK 16 ; Buffer for 80 characters
NBUF: BLOCK 4 ; Buffer for 20 characters
OBUF: BLOCK 3 ; Buffer for 15 characters
BUFEND: ASCIZ / (truncated)/ ; End of all buffers
END