d6
/
nxu
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

merge

This commit is contained in:
~d6 2023-08-17 14:07:51 -04:00
parent c7f40752ad 036077e0aa
commit 36fe7878df
1 changed files with 57 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

86
tar.tal
View File

@ -66,15 +66,6 @@
;header/size load-octal11 ;header/size load-octal11
round-up-to-512 skip !list round-up-to-512 skip !list
@round-up-to-512 ( carry^ hi* lo* -> )
DUP2 #fe00 GTH2 ?&round-hi
#0200 OVR2 #01ff AND2 SUB2 ADD2 JMP2r
&round-hi
POP2 DUP2 #ffff EQU2 ?&round-carry INC2 #0000 JMP2r
&round-carry
POP2 DUP #ff EQU ?&overflow INC #0000 #0000 JMP2r
&overflow #0000 DIV
@list-dir ( 00^ -> ) @list-dir ( 00^ -> )
POP POP
LIT "d #18 DEO #2018 DEO LIT "d #18 DEO #2018 DEO
@ -85,19 +76,49 @@
;unsupported print emit/byte #0a18 DEO !panic ;unsupported print emit/byte #0a18 DEO !panic
!list !list
@emit5 ( carry^ hi* lo* -> ) ( write data from memory into the tar file )
STH2 STH2 emit/byte STH2r STH2r !emit/long @write-memory ( filename* size* data* -> )
STH2 STH2k write-file-header ( [data* size*] )
STH2r STH2r write-file-body JMP2r ( )
.File1/len
@emit @write-file-header ( filename* size* -> )
&long SWP2 ,&short JSR SWP2 ;header/filename copy JMP2r
&short SWP ,&byte JSR write-size-2
&byte DUP #04 SFT ,&char JSR ( TODO: checksum )
&char #0f AND DUP #09 GTH #27 MUL ADD #30 ADD #18 DEO LIT "0 ;header/type STA
#00 ;header/linkname STA
JMP2r JMP2r
@write-file-body ( size* data* -> )
SWP2 .File1/len DEO2 .File1/w DEO2 JMP2r
@mod ( x* y* -> x%y* )
DIV2k MUL2 SUB2 JMP2r
@write-size-2 ( size* -> )
;header/size STH2 ( size* [start*] )
LIT2r 000a ADD2r ( size* [start* last*] )
&loop ( size* [start* pos*] )
LTH2kr STHr ?&done ( size* [start* pos*] )
DUP2 #0007 AND2 ( size* size%8* [start* pos*] )
NIP LIT "0 ADD ( size* octal^ [start* pos*] )
STH2kr STA ( size* [start* pos*] )
#03 SFT2 ( size/8* [start* pos*] )
LIT2 0001 SUB2 !&loop ( size/8* [start* pos-1*] )
&done ( zero* [start* pos*] )
POP2 POP2r POP2r JMP2r ( )
@copy ( src* dst* -> )
STH2
&loop
LDAk DUP STH2kr STA2 ?&ok
POP2 POP2r JMP2r
&ok INC2 INC2r !&loop
@read-error "error 20 "reading 20 "data 0a 00 @read-error "error 20 "reading 20 "data 0a 00
( skips carry*2^32 + hi*2^16 + lo bytes ) ( skips n bytes, specified as a 5-byte integer )
@skip ( carry^ hi* lo* -> ) @skip ( carry^ hi* lo* -> )
skip-lo ( carry^ hi* ) skip-lo ( carry^ hi* )
skip-hi ( carry^ ) skip-hi ( carry^ )
@ -128,18 +149,6 @@
;read-error print !panic ;read-error print !panic
&ok JMP2r &ok JMP2r
@is-size-32 ( -> bool^ )
;header/size LDA LIT "4 LTH JMP2r
@is-size-16 ( -> bool^ )
;header/size LDAk LIT "0 NEQ ?&fail
INC2 LDAk LIT "0 NEQ ?&fail
INC2 LDAk LIT "0 NEQ ?&fail
INC2 LDAk LIT "0 NEQ ?&fail
INC2 LDAk LIT "0 NEQ ?&fail
INC2 LDA LIT "2 LTH JMP2r
&fail POP2 #00 JMP2r
@octal-digit ( char^ -> oct^ ) @octal-digit ( char^ -> oct^ )
LIT "0 DUP2 LTH ?&zero SUB JMP2r &zero POP2 #00 JMP2r LIT "0 DUP2 LTH ?&zero SUB JMP2r &zero POP2 #00 JMP2r
@ -171,6 +180,25 @@
#03 SFT2 ORAk ?&loop ( addr+1* place>>3* [sum2*] ) #03 SFT2 ORAk ?&loop ( addr+1* place>>3* [sum2*] )
POP2 POP2 STH2r JMP2r ( sum2* ) POP2 POP2 STH2r JMP2r ( sum2* )
( emit 1, 2, 4, or 5 bytes as a decimal number )
@emit
&1+long STH2 STH2 ,&byte JSR STH2r STH2r
&long SWP2 ,&short JSR
&short SWP ,&byte JSR
&byte DUP #04 SFT ,&char JSR
&char #0f AND DUP #09 GTH #27 MUL ADD #30 ADD #18 DEO
JMP2r
( round a given 5-byte size up to multiples of 512 )
@round-up-to-512 ( carry^ hi* lo* -> )
DUP2 #fe00 GTH2 ?&round-hi
#0200 OVR2 #01ff AND2 SUB2 ADD2 JMP2r
&round-hi
POP2 DUP2 #ffff EQU2 ?&round-carry INC2 #0000 JMP2r
&round-carry
POP2 DUP #ff EQU ?&overflow INC #0000 #0000 JMP2r
&overflow #0000 DIV
( header/size is 11 octal digits; 12th digit is NUL ) ( header/size is 11 octal digits; 12th digit is NUL )
( octal 77777777777 = #01 #ffff #ffff ) ( octal 77777777777 = #01 #ffff #ffff )
( octal 37777777777 = #ffff #ffff ) ( octal 37777777777 = #ffff #ffff )