;	WedýÙyäÃy  Sept 24,1980  4:04  FQ+7D.8H.11M.19S.  -*- Midas -*-

;;; Now that lisp will get its own ddt symbols for XTRASYMS and
;;; GLOBALSYMS, this should be coded in lap and included in the
;;; appropriate place(s).

.FASL
IF1,[
  .INSRT SYS:.FASL DEFS
LINKP==0
]

DCONS:	;; Takes disk-format-date in F, and returns datelist in A.
	;; Doesn't clobber F.
	LDB TT,[220500,,F]
	JSP T,FXCONS
	JSP T,%NCONS
	LDB TT,[270400,,F]
	MOVEI B,(A)
	JSP T,FXCONS
	JSP T,%CONS
	MOVEI B,(A)
	LDB TT,[331000,,F]
	JSP T,FXCONS
	POP P,T
	JRST %CONS

TCONS:	;; Right half of F is taken as # of 1/2 seconds past midnight.
	;; Returns a timelist.
	HRRZ D,F
	LSH D,-1	;; convert to seconds (this truncates!)
			;; but if it doesn't you might have 60. secs!
	IDIVI D,60.	;; minutes past midn in D, seconds left in R.
	MOVE TT,R
	JSP T,FXCONS
	JSP T,%NCONS
	MOVEI B,(A)
	IDIVI D,60.	;; Hours past mid in D, minutes left in R.
	MOVE TT,R
	JSP T,FXCONS
	JSP T,%CONS
	MOVEI B,(A)
	MOVE TT,D
	CAIL TT,24.
	  .VALUE
	JSP T,FXCONS
	POP P,T
	JRST %CONS 


DFILE:	SETZ B,
DFILE1:	CAIN A,.ATOM T
	  MOVEI A,.SX (T )
	JCALL 2,.FUNCTION MERGEF


.ENTRY GET-FILE-INFO SUBR 002
	PUSHJ P,DFILE
	PUSHJ P,FIL6BT
	JSP T,0PUSH-6
	LOCKI
	.CALL [SETZ ? SIXBIT \OPEN\ ? MOVSI .UII ? MOVEI 0
		MOVE -12(FXP) ? MOVE -10(FXP) ? MOVE -7(FXP)
		MOVE -11(FXP) ? SETZB TT]
	  JRST [UNLOCKI ? SUB FXP,[12,,12] ? JRST RERCD$]
	.CALL [SETZ ? SIXBIT \RESRDT\ ? SETZI 0]
	  JFCL
	.CALL [SETZ ? SIXBIT \RFNAME\ ? MOVEI 0
		MOVEM -12(FXP) ? MOVEM -10(FXP)
		MOVEM -7(FXP) ? SETZM -11(FXP)]
	  IOJRST [LERR (C)]
	MOVEI T,-6(FXP)
	HRLI T,444400
	MOVEI D,2
	.CALL [SETZ ? SIXBIT \SIOT\ ? MOVEI 0 ? MOVE T ? SETZ D]
	  IOJRST [LERR (C)]
	.CALL [SETZ ? SIXBIT \FILBLK\ ? MOVEI 0 
		MOVEM T		;; first filename, ignore
		MOVEM T		;; second filename, ignore
		MOVEM T		;; random info, ignore
		MOVEM -4(FXP)	;; creation date/time
		SETZM -3(FXP)	;; refdate + random info
		]
	  JRST [SETOM -4(FXP) ? SETOM -3(FXP) ? JRST .+1]
	.CALL [SETZ ? SIXBIT \FILLEN\ ? MOVEI 0
		MOVEM T		;; length in mode open in
		MOVEM T		;; bytesize open in
		MOVEM -1(FXP)	;; length in bytesize written in
		SETZM TT]	;; bytesize written in
	  SETOB TT,-1(FXP)
	.CALL [SETZ ? SIXBIT \RAUTH\ ? MOVEI 0 ? SETZM -2(FXP)]
	  SETZM -2(FXP)
	.CLOSE 0,
	UNLOCKI
	PUSH P,[NIL]
	JUMPL TT,[SUB FXP,[1,,1] ? JRST FINFO0]
	JSP T,FXCONS
	JSP T,%NCONS
	MOVEI B,.ATOM BYTESIZE
	JSP T,%XCONS
	MOVEI B,(A)
	POP FXP,TT
	JSP T,FXCONS
	JSP T,%CONS
	MOVEI B,.ATOM BYTES
	JSP T,%XCONS
	MOVEM A,(P)
FINFO0:	POP FXP,TT
	JUMPE TT,FINFO6
	PUSHJ P,SIXATM
	MOVE B,(P)
	JSP T,%CONS
	MOVEI B,.ATOM AUTHOR
	JSP T,%XCONS
	MOVEM A,(P)
FINFO6:	POP FXP,F
	JUMPL F,FINFO1
	PUSHJ P,DCONS
	MOVE B,(P)
	JSP T,%CONS
	MOVEI B,.ATOM REFDATE
	JSP T,%XCONS
	MOVEM A,(P)
FINFO1:	POP FXP,F
	JUMPL F,FINFO2
	PUSHJ P,DCONS
	MOVE B,(P)
	JSP T,%CONS
	MOVEI B,.ATOM CREDATE
	JSP T,%XCONS
	MOVEM A,(P)
	PUSHJ P,TCONS
	MOVE B,(P)
	JSP T,%CONS
	MOVEI B,.ATOM CRETIME
	JSP T,%XCONS
	MOVEM A,(P)
FINFO2:	MOVE TT,-1(FXP)
	TRZ TT,1
	CAME TT,[SIXBIT \*FASL*\]
	  JRST FINFO3
	MOVE TT,(FXP)
	LDB T,[360600,,TT]
	CAIN T,'M
	  JRST [LSH TT,6 ? MOVEI A,.ATOM MIDAS ? JRST FINFO4]
	HLRZS TT
	CAIL TT,'500
	  TLOA TT,'1
	    TLO TT,'2
	LSH TT,12.
	MOVEI A,.ATOM LISP
FINFO4:	PUSH P,A
	PUSHJ P,SIXATM
	JSP T,%NCONS
	POP P,B
	JSP T,%XCONS
	MOVE B,(P)
	JSP T,%CONS
	MOVEI B,.ATOM CREATOR
	JSP T,%XCONS
	MOVEI AR1,.ATOM FASL
FINFO5:	MOVEI B,.ATOM T
	JSP T,%XCONS
	MOVEI B,(AR1)
	JSP T,%XCONS
	MOVEM A,(P)
FINFO3:	SUB FXP,[2,,2]
	PUSHJ P,6BTNML
	POP P,B
	POP P,T
	JRST %CONS


.ENTRY READ-ERROR-CODE-REASON SUBR 002
RERCD:	JSP T,FXNV1
	TLNE TT,-1
	  JRST [WTA [ILLEGAL ERROR CODE - READ-ERROR-CODE-REASON!]
		JRST RERCD]
RERCD$:	HRLZS TT
	PUSH FLP,INHIBIT
	SETOM INHIBIT
	PUSH FXP,[-1]
	.CALL [SETZ ? SIXBIT \OPEN\ ? MOVSI .UAI ? MOVEI 0
		MOVE [SIXBIT \ERR\]
		MOVE [3]
		SETZ TT]
	  IOJRST [LER3 (C)]
RERCD0:	MOVE TT,[440700,,D]
	MOVEI T,5.
	.CALL [SETZ ? SIXBIT \SIOT\ ? MOVEI 0 ? TT ? SETZ T]
	  IOJRST [LERR (C)]
	CAIN T,5.
	  .VALUE
	TRZ D,1
	MOVE TT,[440700,,D]
	MOVEI T,5.
RERCD1:	ILDB R,TT
	CAIN R,13.
	  JRST RERCD2
	SOJG T,RERCD1
	PUSH FXP,D
	JRST RERCD0

RERCD2:	SETZ R,
RERCD3:	DPB R,TT
	IBP TT
	SOJG T,RERCD3
	SKIPE D
	  PUSH FXP,D
	.CLOSE 0,
	POP FLP,INHIBIT
	PUSHJ P,CHECKI
	SETZ A,
RERCD4:	POP FXP,TT
	TRNE TT,1
	  JRST RERCD5
	MOVEI B,(A)
	JSP T,FXCONS
	JSP T,%CONS
	JRST RERCD4

RERCD5:	MOVEI B,.ATOM T
	JCALL 2,.FUNCTION PNPUT 

.ENTRY *READ-FILE-CREATION-DATE SUBR 002
	PUSHJ P,RQFILE
	MOVEI TT,F.CHAN
	MOVE R,@TTSAR(A)
	.CALL RFDATE
	  JRST [UNLOCKI ? MOVE TT,T ? JRST RERCD$]
	UNLOCKI
DTCONS:	PUSHJ P,DCONS
	PUSH P,A
	PUSHJ P,TCONS
	POP P,B
	POP P,T
	JRST %XCONS

RFDATE:	SETZ
	SIXBIT \RFDATE\
	MOVE R
	MOVEM F
	SETZB T

PROBEF:	SETZ
	SIXBIT \OPEN\
	MOVSI .UAI	;; unit ascii input
	MOVEI 0		;; channel 0
	MOVE -4(FXP)	;; device
	MOVE -2(FXP)	;; filename 1
	MOVE -1(FXP)	;; filename 2
	MOVE -3(FXP)	;; directory/sname
	SETZB F		;; error code

.ENTRY READ-FILE-CREATION-DATE SUBR 002
	;; One arg, a filename.  Returns value as for
	;; *READ-FILE-CREATION-DATE.  Gives IO-LOSSAGE error if
	;; OPEN fails.
	PUSHJ P,DFILE
	PUSH P,A
	PUSHJ P,FIL6BT
	LOCKI
	.CALL PROBEF
	  JRST [UNLOCKI
		SUB FXP,[4,,4]
		SUB P,[1,,1]
		MOVE TT,F
		JRST RERCD$]
	.CALL RESRD0
	  JFCL
	SETZB R,A
	.CALL RFDATE
	  SKIPA T,CPOPJ
	   MOVEI T,DTCONS
	.CLOSE 0,
	UNLOCKI
	SUB FXP,[4,,4]
	SUB P,[1,,1]
	JRST (T)

RESRD0:	SETZ
	SIXBIT \RESRDT\
	SETZI 0 

IFN LINKP,[

LINKS:	;; Setup for the linking functions.
	;; Leaves the 6bit on FXP, 'from' on 'top'.
	;; Skips if the device names are the same.
	PUSH P,B
	PUSHJ P,DFILE
	MOVEI B,(A)
	EXCH A,(P)
	PUSHJ P,DFILE1
	PUSHJ P,FIL6BT
	POP P,A
	PUSHJ P,FIL6BT
	MOVE TT,-3(FXP)
	CAMN TT,-7(FXP)
POPSKP:	  AOS (P)
	POPJ P,

.ENTRY LINKNF SUBR 003
	PUSHJ P,LINKS
	  JRST MODNAV
	MOVEI F,CPOPJ
	SETZ A,
	.CALL MLINK
	  MOVEI F,RERCD$
	SUB FXP,[10,,10]
	JRST (F)

MODNAV:	;; Give a 'mode not available' error for linking across
	;; devices.
	MOVEI TT,12
	JRST LINKF0

.ENTRY LINKF SUBR 003
	;; Like LINKNF, except not allowed to clobber files... 
	;; (Simulates a 'file already exists' error)
	PUSHJ P,LINKS
	  JRST MODNAV
	MOVSI TT,(SIXBIT |>|)
	MOVSI D,(SIXBIT |<|)
	CAME TT,(FXP)
	  CAMN TT,-1(FXP)
	    JRST LINKF
	CAME D,(FXP)
	  CAMN D,-1(FXP)
	    JRST LINKF
	LOCKI
	.CALL PROBEF
	  JRST [UNLOCKI ? JRST LINKF]
	.CALL RESRD0
	  JFCL
	.CLOSE 0,
	MOVEI TT,13
LINKF0:	SUB FXP,[10,,10]
	JRST RERCD$

LINKF:	.CALL MLINK
	  JRST LINKF0
	SUB FXP,[10,,10]
	SETZ A,
	POPJ P,

MLINK:	SETZ
	SIXBIT \MLINK\
	MOVE -3(FXP)		;; 'from' device
	MOVE -1(FXP)		;; 'from' filename 1
	MOVE (FXP)		;; 'from' filename 2
	MOVE -2(FXP)		;; 'from' sname
	MOVE -5(FXP)		;; 'to' filename 1
	MOVE -4(FXP)		;; 'to' filename 2
	MOVE -6(FXP)		;; 'to' sname
	SETZB TT		;; error code.
] ; end of IFN LINKP

RQFILE:	LOCKI
	POPJ P,


.ENTRY CURRENT-DATE-AND-TIME SUBR 001
	;; Read the current date and time, SYNCHRONIZED!!!!!
	.CALL [SETZ ? SIXBIT \RQDATE\ ? SETZM F]
	  .LOSE %LSSYS
	JUMPGE F,DTCONS
	SETZ A,
	POPJ P,

;;; Should also have a moon-phase hacker...  that would necessitate
;;; a lot of other crap, which wouldn't be all that unreasonable to
;;; have;  eg, perpetual-calender type of stuff, knowing the number of
;;; days in each month, etc.

FASEND